1/*
2
3 BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2, 3 & 4
4
5 written by Paul Marquess <pmqs@cpan.org>
6
7 All comments/suggestions/problems are welcome
8
9     Copyright (c) 1997-2009 Paul Marquess. All rights reserved.
10     This program is free software; you can redistribute it and/or
11     modify it under the same terms as Perl itself.
12
13     Please refer to the COPYRIGHT section in
14
15 Changes:
16        0.01 -  First Alpha Release
17        0.02 -
18
19*/
20
21
22
23#ifdef __cplusplus
24extern "C" {
25#endif
26
27#define PERL_POLLUTE
28#include "EXTERN.h"
29#include "perl.h"
30#include "XSUB.h"
31#include "ppport.h"
32
33
34/* XSUB.h defines a macro called abort 				*/
35/* This clashes with the txn abort method in Berkeley DB 4.x	*/
36/* This is a problem with ActivePerl (at least)			*/
37
38#ifdef _WIN32
39#  ifdef abort
40#    undef abort
41#  endif
42#  ifdef fopen
43#    undef fopen
44#  endif
45#  ifdef fclose
46#    undef fclose
47#  endif
48#  ifdef rename
49#    undef rename
50#  endif
51#  ifdef open
52#    undef open
53#  endif
54#endif
55
56#ifndef SvUTF8_off
57# define SvUTF8_off(x)
58#endif
59
60/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
61 * shortly #included by the <db.h>) __attribute__ to the possibly
62 * already defined __attribute__, for example by GNUC or by Perl. */
63
64#undef __attribute__
65
66#ifdef USE_PERLIO
67#    define GetFILEptr(sv) PerlIO_findFILE(IoIFP(sv_2io(sv)))
68#else
69#    define GetFILEptr(sv) IoIFP(sv_2io(sv))
70#endif
71
72#include <db.h>
73
74/* Check the version of Berkeley DB */
75
76#ifndef DB_VERSION_MAJOR
77#ifdef HASHMAGIC
78#error db.h is from Berkeley DB 1.x - need at least Berkeley DB 2.6.4
79#else
80#error db.h is not for Berkeley DB at all.
81#endif
82#endif
83
84#if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6) ||\
85    (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 6 && DB_VERSION_PATCH < 4)
86#  error db.h is from Berkeley DB 2.0-2.5 - need at least Berkeley DB 2.6.4
87#endif
88
89
90#if (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0)
91#  define IS_DB_3_0_x
92#endif
93
94#if DB_VERSION_MAJOR >= 3
95#  define AT_LEAST_DB_3
96#endif
97
98#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 1)
99#  define AT_LEAST_DB_3_1
100#endif
101
102#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
103#  define AT_LEAST_DB_3_2
104#endif
105
106#if DB_VERSION_MAJOR > 3 || \
107    (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 2) ||\
108    (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 2 && DB_VERSION_PATCH >= 6)
109#  define AT_LEAST_DB_3_2_6
110#endif
111
112#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
113#  define AT_LEAST_DB_3_3
114#endif
115
116#if DB_VERSION_MAJOR >= 4
117#  define AT_LEAST_DB_4
118#endif
119
120#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
121#  define AT_LEAST_DB_4_1
122#endif
123
124#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 2)
125#  define AT_LEAST_DB_4_2
126#endif
127
128#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
129#  define AT_LEAST_DB_4_3
130#endif
131
132#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 4)
133#  define AT_LEAST_DB_4_4
134#endif
135
136#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 5)
137#  define AT_LEAST_DB_4_5
138#endif
139
140#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 6)
141#  define AT_LEAST_DB_4_6
142#endif
143
144#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 7)
145#  define AT_LEAST_DB_4_7
146#endif
147
148#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 8)
149#  define AT_LEAST_DB_4_8
150#endif
151
152#ifdef __cplusplus
153}
154#endif
155
156#define DBM_FILTERING
157#define STRICT_CLOSE
158/* #define ALLOW_RECNO_OFFSET */
159/* #define TRACE */
160
161#if DB_VERSION_MAJOR == 2 && ! defined(DB_LOCK_DEADLOCK)
162#  define DB_LOCK_DEADLOCK	EAGAIN
163#endif /* DB_VERSION_MAJOR == 2 */
164
165#if DB_VERSION_MAJOR == 2
166#  define DB_QUEUE		4
167#endif /* DB_VERSION_MAJOR == 2 */
168
169#if DB_VERSION_MAJOR == 2
170#  define BackRef	internal
171#else
172#  if DB_VERSION_MAJOR == 3 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0)
173#    define BackRef	cj_internal
174#  else
175#    define BackRef	api_internal
176#  endif
177#endif
178
179#ifdef AT_LEAST_DB_3_2
180#    define DB_callback	DB * db,
181#else
182#    define DB_callback
183#endif
184
185#if DB_VERSION_MAJOR > 2
186typedef struct {
187        int              db_lorder;
188        size_t           db_cachesize;
189        size_t           db_pagesize;
190
191
192        void *(*db_malloc) __P((size_t));
193        int (*dup_compare)
194            __P((DB_callback const DBT *, const DBT *));
195
196        u_int32_t        bt_maxkey;
197        u_int32_t        bt_minkey;
198        int (*bt_compare)
199            __P((DB_callback const DBT *, const DBT *));
200        size_t (*bt_prefix)
201            __P((DB_callback const DBT *, const DBT *));
202
203        u_int32_t        h_ffactor;
204        u_int32_t        h_nelem;
205        u_int32_t      (*h_hash)
206            __P((DB_callback const void *, u_int32_t));
207
208        int              re_pad;
209        int              re_delim;
210        u_int32_t        re_len;
211        char            *re_source;
212
213#define DB_DELIMITER            0x0001
214#define DB_FIXEDLEN             0x0008
215#define DB_PAD                  0x0010
216        u_int32_t        flags;
217        u_int32_t        q_extentsize;
218} DB_INFO ;
219
220#endif /* DB_VERSION_MAJOR > 2 */
221
222typedef struct {
223	int		Status ;
224	/* char		ErrBuff[1000] ; */
225	SV *		ErrPrefix ;
226	SV *		ErrHandle ;
227#ifdef AT_LEAST_DB_4_3
228	SV *		MsgHandle ;
229#endif
230	DB_ENV *	Env ;
231	int		open_dbs ;
232	int		TxnMgrStatus ;
233	int		active ;
234	bool		txn_enabled ;
235	bool		opened ;
236	bool		cds_enabled;
237	} BerkeleyDB_ENV_type ;
238
239
240typedef struct {
241        DBTYPE  	type ;
242	bool		recno_or_queue ;
243	char *		filename ;
244	BerkeleyDB_ENV_type * parent_env ;
245        DB *    	dbp ;
246        SV *    	compare ;
247        bool    	in_compare ;
248        SV *    	dup_compare ;
249        bool    	in_dup_compare ;
250        SV *    	prefix ;
251        bool    	in_prefix ;
252        SV *   	 	hash ;
253        bool    	in_hash ;
254#ifdef AT_LEAST_DB_3_3
255        SV *   	 	associated ;
256        bool		secondary_db ;
257#endif
258#ifdef AT_LEAST_DB_4_8
259        SV *   	 	associated_foreign ;
260        SV *   	 	bt_compress ;
261        SV *   	 	bt_uncompress ;
262#endif
263        bool		primary_recno_or_queue ;
264	int		Status ;
265        DB_INFO *	info ;
266        DBC *   	cursor ;
267	DB_TXN *	txn ;
268	int		open_cursors ;
269#ifdef AT_LEAST_DB_4_3
270	int		open_sequences ;
271#endif
272	u_int32_t	partial ;
273	u_int32_t	dlen ;
274	u_int32_t	doff ;
275	int		active ;
276	bool		cds_enabled;
277#ifdef ALLOW_RECNO_OFFSET
278	int		array_base ;
279#endif
280#ifdef DBM_FILTERING
281        SV *    filter_fetch_key ;
282        SV *    filter_store_key ;
283        SV *    filter_fetch_value ;
284        SV *    filter_store_value ;
285        int     filtering ;
286#endif
287        } BerkeleyDB_type;
288
289
290typedef struct {
291        DBTYPE  	type ;
292	bool		recno_or_queue ;
293	char *		filename ;
294        DB *    	dbp ;
295        SV *    	compare ;
296        SV *    	dup_compare ;
297        SV *    	prefix ;
298        SV *   	 	hash ;
299#ifdef AT_LEAST_DB_3_3
300        SV *   	 	associated ;
301	bool		secondary_db ;
302#endif
303#ifdef AT_LEAST_DB_4_8
304        SV *   	 	associated_foreign ;
305#endif
306	bool		primary_recno_or_queue ;
307	int		Status ;
308        DB_INFO *	info ;
309        DBC *   	cursor ;
310	DB_TXN *	txn ;
311	BerkeleyDB_type *		parent_db ;
312	u_int32_t	partial ;
313	u_int32_t	dlen ;
314	u_int32_t	doff ;
315	int		active ;
316	bool		cds_enabled;
317#ifdef ALLOW_RECNO_OFFSET
318	int		array_base ;
319#endif
320#ifdef DBM_FILTERING
321        SV *    filter_fetch_key ;
322        SV *    filter_store_key ;
323        SV *    filter_fetch_value ;
324        SV *    filter_store_value ;
325        int     filtering ;
326#endif
327        } BerkeleyDB_Cursor_type;
328
329typedef struct {
330	BerkeleyDB_ENV_type *	env ;
331	} BerkeleyDB_TxnMgr_type ;
332
333#if 1
334typedef struct {
335	int		Status ;
336	DB_TXN *	txn ;
337	int		active ;
338	} BerkeleyDB_Txn_type ;
339#else
340typedef DB_TXN                BerkeleyDB_Txn_type ;
341#endif
342
343#ifdef AT_LEAST_DB_4_3
344typedef struct {
345    int active;
346    BerkeleyDB_type *db;
347    DB_SEQUENCE     *seq;
348} BerkeleyDB_Sequence_type;
349#else
350typedef int BerkeleyDB_Sequence_type;
351typedef SV* db_seq_t;
352#endif
353
354
355typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env ;
356typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env__Raw ;
357typedef BerkeleyDB_ENV_type *	BerkeleyDB__Env__Inner ;
358typedef BerkeleyDB_type * 	BerkeleyDB ;
359typedef void * 			BerkeleyDB__Raw ;
360typedef BerkeleyDB_type *	BerkeleyDB__Common ;
361typedef BerkeleyDB_type *	BerkeleyDB__Common__Raw ;
362typedef BerkeleyDB_type *	BerkeleyDB__Common__Inner ;
363typedef BerkeleyDB_type * 	BerkeleyDB__Hash ;
364typedef BerkeleyDB_type * 	BerkeleyDB__Hash__Raw ;
365typedef BerkeleyDB_type * 	BerkeleyDB__Btree ;
366typedef BerkeleyDB_type * 	BerkeleyDB__Btree__Raw ;
367typedef BerkeleyDB_type * 	BerkeleyDB__Recno ;
368typedef BerkeleyDB_type * 	BerkeleyDB__Recno__Raw ;
369typedef BerkeleyDB_type * 	BerkeleyDB__Queue ;
370typedef BerkeleyDB_type * 	BerkeleyDB__Queue__Raw ;
371typedef BerkeleyDB_Cursor_type   	BerkeleyDB__Cursor_type ;
372typedef BerkeleyDB_Cursor_type * 	BerkeleyDB__Cursor ;
373typedef BerkeleyDB_Cursor_type * 	BerkeleyDB__Cursor__Raw ;
374typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr ;
375typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Raw ;
376typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Inner ;
377typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn ;
378typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn__Raw ;
379typedef BerkeleyDB_Txn_type *	BerkeleyDB__Txn__Inner ;
380#ifdef AT_LEAST_DB_4_3
381typedef BerkeleyDB_Sequence_type * 	BerkeleyDB__Sequence ;
382#else
383typedef int * 	BerkeleyDB__Sequence ;
384#endif
385#if 0
386typedef DB_LOG *      		BerkeleyDB__Log ;
387typedef DB_LOCKTAB *  		BerkeleyDB__Lock ;
388#endif
389typedef DBT 			DBTKEY ;
390typedef DBT 			DBT_OPT ;
391typedef DBT 			DBT_B ;
392typedef DBT 			DBTKEY_B ;
393typedef DBT 			DBTKEY_Br ;
394typedef DBT 			DBTKEY_Bpr ;
395typedef DBT 			DBTKEY_seq ;
396typedef DBT 			DBTVALUE ;
397typedef void *	      		PV_or_NULL ;
398typedef PerlIO *      		IO_or_NULL ;
399typedef int			DualType ;
400typedef SV          SVnull;
401
402static void
403hash_delete(char * hash, char * key);
404
405#ifdef TRACE
406#  define Trace(x)	(printf("# "), printf x)
407#else
408#  define Trace(x)
409#endif
410
411#ifdef ALLOW_RECNO_OFFSET
412#  define RECNO_BASE	db->array_base
413#else
414#  define RECNO_BASE	1
415#endif
416
417#if DB_VERSION_MAJOR == 2
418#  define flagSet_DB2(i, f) i |= f
419#else
420#  define flagSet_DB2(i, f)
421#endif
422
423#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
424#  define flagSet(bitmask)        (flags & (bitmask))
425#else
426#  define flagSet(bitmask)	((flags & DB_OPFLAGS_MASK) == (bitmask))
427#endif
428
429#ifdef DB_GET_BOTH_RANGE
430#  define flagSetBoth() (flagSet(DB_GET_BOTH) || flagSet(DB_GET_BOTH_RANGE))
431#else
432#  define flagSetBoth() (flagSet(DB_GET_BOTH))
433#endif
434
435#ifndef AT_LEAST_DB_4
436typedef	int db_timeout_t ;
437#endif
438
439#define ERR_BUFF "BerkeleyDB::Error"
440
441#define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \
442				Zero(to,1,typ))
443
444#define DBT_clear(x)	Zero(&x, 1, DBT) ;
445
446#if 1
447#define getInnerObject(x) (*av_fetch((AV*)SvRV(x), 0, FALSE))
448#else
449#define getInnerObject(x) ((SV*)SvRV(sv))
450#endif
451
452#define my_sv_setpvn(sv, d, s) do { \
453                        s ? sv_setpvn(sv, d, s) : sv_setpv(sv, ""); \
454                        SvUTF8_off(sv); \
455                    } while(0)
456
457#define GetValue_iv(h,k) (((sv = readHash(h, k)) && sv != &PL_sv_undef) \
458				? SvIV(sv) : 0)
459#define SetValue_iv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
460				i = SvIV(sv)
461#define SetValue_io(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
462				i = GetFILEptr(sv)
463#define SetValue_sv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
464				i = sv
465#define SetValue_pv(i, k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
466				i = (t)SvPV(sv,PL_na)
467#define SetValue_pvx(i, k, t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
468				i = (t)SvPVX(sv)
469#define SetValue_ov(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
470				IV tmp = SvIV(getInnerObject(sv)) ;	\
471				i = INT2PTR(t, tmp) ;			\
472			  }
473
474#define SetValue_ovx(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
475				HV * hv = (HV *)GetInternalObject(sv);		\
476				SV ** svp = hv_fetch(hv, "db", 2, FALSE);\
477				IV tmp = SvIV(*svp);			\
478				i = INT2PTR(t, tmp) ;				\
479			  }
480
481#define SetValue_ovX(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
482				IV tmp = SvIV(GetInternalObject(sv));\
483				i = INT2PTR(t, tmp) ;				\
484			  }
485
486#define LastDBerror DB_RUNRECOVERY
487
488#define setDUALerrno(var, err)					\
489		sv_setnv(var, (double)err) ;			\
490		sv_setpv(var, ((err) ? db_strerror(err) : "")) ;\
491		SvNOK_on(var);
492
493#define OutputValue(arg, name)                                  \
494        { if (RETVAL == 0) {                                    \
495              my_sv_setpvn(arg, name.data, name.size) ;         \
496              DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ;            \
497          }                                                     \
498        }
499
500#define OutputValue_B(arg, name)                                  \
501        { if (RETVAL == 0) {                                    \
502		if (db->type == DB_BTREE && 			\
503			flagSet(DB_GET_RECNO)){			\
504                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
505                }                                               \
506                else {                                          \
507                    my_sv_setpvn(arg, name.data, name.size) ;   \
508                }                                               \
509                DBM_ckFilter(arg, filter_fetch_value, "filter_fetch_value");          \
510          }                                                     \
511        }
512
513#define OutputKey(arg, name)                                    \
514        { if (RETVAL == 0) 					\
515          {                                                     \
516                if (!db->recno_or_queue) {                     	\
517                    my_sv_setpvn(arg, name.data, name.size);    \
518                }                                               \
519                else                                            \
520                    sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE);   \
521                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
522          }                                                     \
523        }
524
525#ifdef AT_LEAST_DB_4_3
526
527#define InputKey_seq(arg, var)  \
528	{   \
529	    SV* my_sv = arg ;   \
530	    /* DBM_ckFilter(my_sv, filter_store_key, "filter_store_key"); */ \
531	    DBT_clear(var) ;    \
532        SvGETMAGIC(arg) ;   \
533	    if (seq->db->recno_or_queue) {  \
534	        Value = GetRecnoKey(seq->db, SvIV(my_sv)) ;     \
535	        var.data = & Value;     \
536	        var.size = (int)sizeof(db_recno_t); \
537	    }   \
538	    else {  \
539            STRLEN len; \
540	        var.data = SvPV(my_sv, len);    \
541	        var.size = (int)len;    \
542	    }   \
543	}
544
545#define OutputKey_seq(arg, name)                                    \
546        { if (RETVAL == 0) 					\
547          {                                                     \
548                if (!seq->db->recno_or_queue) {                     	\
549                    my_sv_setpvn(arg, name.data, name.size);    \
550                }                                               \
551                else                                            \
552                    sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE);   \
553          }                                                     \
554        }
555#else
556#define InputKey_seq(arg, var)
557#define OutputKey_seq(arg, name)
558#endif
559
560#define OutputKey_B(arg, name)                                  \
561        { if (RETVAL == 0) 					\
562          {                                                     \
563                if (db->recno_or_queue 	                        \
564			|| (db->type == DB_BTREE && 		\
565			    flagSet(DB_GET_RECNO))){		\
566                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
567                }                                               \
568                else {                                          \
569                    my_sv_setpvn(arg, name.data, name.size);    \
570                }                                               \
571                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
572          }                                                     \
573        }
574
575#define OutputKey_Br(arg, name)                                  \
576        { if (RETVAL == 0) 					\
577          {                                                     \
578                if (db->recno_or_queue || db->primary_recno_or_queue	\
579			|| (db->type == DB_BTREE && 		\
580			    flagSet(DB_GET_RECNO))){		\
581                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
582                }                                               \
583                else {                                          \
584                    my_sv_setpvn(arg, name.data, name.size);    \
585                }                                               \
586                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
587          }                                                     \
588        }
589
590#define OutputKey_Bpr(arg, name)                                  \
591        { if (RETVAL == 0) 					\
592          {                                                     \
593                if (db->primary_recno_or_queue	\
594			|| (db->type == DB_BTREE && 		\
595			    flagSet(DB_GET_RECNO))){		\
596                    sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
597                }                                               \
598                else {                                          \
599                    my_sv_setpvn(arg, name.data, name.size);    \
600                }                                               \
601                DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ;            \
602          }                                                     \
603        }
604
605#define SetPartial(data,db) 					\
606	data.flags = db->partial ;				\
607	data.dlen  = db->dlen ;					\
608	data.doff  = db->doff ;
609
610#define ckActive(active, type) 					\
611    {								\
612	if (!active)						\
613	    softCrash("%s is already closed", type) ;		\
614    }
615
616#define ckActive_Environment(a)	ckActive(a, "Environment")
617#define ckActive_TxnMgr(a)	ckActive(a, "Transaction Manager")
618#define ckActive_Transaction(a) ckActive(a, "Transaction")
619#define ckActive_Database(a) 	ckActive(a, "Database")
620#define ckActive_Cursor(a) 	ckActive(a, "Cursor")
621#ifdef AT_LEAST_DB_4_3
622#define ckActive_Sequence(a) 	ckActive(a, "Sequence")
623#else
624#define ckActive_Sequence(a)
625#endif
626
627#define dieIfEnvOpened(e, m) if (e->opened) softCrash("Cannot call method BerkeleyDB::Env::%s after environment has been opened", m);
628
629#define isSTDOUT_ERR(f) ((f) == stdout || (f) == stderr)
630
631
632/* Internal Global Data */
633#define MY_CXT_KEY "BerkeleyDB::_guts" XS_VERSION
634
635typedef struct {
636    db_recno_t	x_Value;
637    db_recno_t	x_zero;
638    DBTKEY	x_empty;
639#ifndef AT_LEAST_DB_3_2
640    BerkeleyDB	x_CurrentDB;
641#endif
642} my_cxt_t;
643
644START_MY_CXT
645
646#define Value		(MY_CXT.x_Value)
647#define zero		(MY_CXT.x_zero)
648#define empty		(MY_CXT.x_empty)
649
650#ifdef AT_LEAST_DB_3_2
651#  define CurrentDB ((BerkeleyDB)db->BackRef)
652#else
653#  define CurrentDB	(MY_CXT.x_CurrentDB)
654#endif
655
656#ifdef AT_LEAST_DB_3_2
657#    define getCurrentDB ((BerkeleyDB)db->BackRef)
658#    define saveCurrentDB(db)
659#else
660#    define getCurrentDB (MY_CXT.x_CurrentDB)
661#    define saveCurrentDB(db) (MY_CXT.x_CurrentDB) = db
662#endif
663
664#if 0
665static char	ErrBuff[1000] ;
666#endif
667
668#ifdef AT_LEAST_DB_3_3
669#    if PERL_REVISION == 5 && PERL_VERSION <= 4
670
671/* saferealloc in perl5.004 will croak if it is given a NULL pointer*/
672void *
673MyRealloc(void * ptr, size_t size)
674{
675    if (ptr == NULL )
676        return safemalloc(size) ;
677    else
678        return saferealloc(ptr, size) ;
679}
680
681#    else
682#        define MyRealloc saferealloc
683#    endif
684#endif
685
686static char *
687my_strdup(const char *s)
688{
689    if (s == NULL)
690        return NULL ;
691
692    {
693        MEM_SIZE l = strlen(s) + 1;
694        char *s1 = (char *)safemalloc(l);
695
696        Copy(s, s1, (MEM_SIZE)l, char);
697        return s1;
698    }
699}
700
701#if DB_VERSION_MAJOR == 2
702static char *
703db_strerror(int err)
704{
705    if (err == 0)
706        return "" ;
707
708    if (err > 0)
709        return Strerror(err) ;
710
711    switch (err) {
712	case DB_INCOMPLETE:
713		return ("DB_INCOMPLETE: Sync was unable to complete");
714	case DB_KEYEMPTY:
715		return ("DB_KEYEMPTY: Non-existent key/data pair");
716	case DB_KEYEXIST:
717		return ("DB_KEYEXIST: Key/data pair already exists");
718	case DB_LOCK_DEADLOCK:
719		return (
720		    "DB_LOCK_DEADLOCK: Locker killed to resolve a deadlock");
721	case DB_LOCK_NOTGRANTED:
722		return ("DB_LOCK_NOTGRANTED: Lock not granted");
723	case DB_LOCK_NOTHELD:
724		return ("DB_LOCK_NOTHELD: Lock not held by locker");
725	case DB_NOTFOUND:
726		return ("DB_NOTFOUND: No matching key/data pair found");
727	case DB_RUNRECOVERY:
728		return ("DB_RUNRECOVERY: Fatal error, run database recovery");
729	default:
730		return "Unknown Error" ;
731
732    }
733}
734#endif 	/* DB_VERSION_MAJOR == 2 */
735
736#ifdef TRACE
737#if DB_VERSION_MAJOR > 2
738static char *
739my_db_strerror(int err)
740{
741    static char buffer[1000] ;
742    SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
743    sprintf(buffer, "%d: %s", err, db_strerror(err)) ;
744    if (err && sv) {
745        strcat(buffer, ", ") ;
746	strcat(buffer, SvPVX(sv)) ;
747    }
748    return buffer;
749}
750#endif
751#endif
752
753static void
754close_everything(void)
755{
756    dTHR;
757    Trace(("close_everything\n")) ;
758    /* Abort All Transactions */
759    {
760	BerkeleyDB__Txn__Raw 	tid ;
761	HE * he ;
762	I32 len ;
763	HV * hv = perl_get_hv("BerkeleyDB::Term::Txn", TRUE);
764	int  all = 0 ;
765	int  closed = 0 ;
766	(void)hv_iterinit(hv) ;
767	Trace(("BerkeleyDB::Term::close_all_txns dirty=%d\n", PL_dirty)) ;
768	while ( (he = hv_iternext(hv)) ) {
769	    tid = * (BerkeleyDB__Txn__Raw *) hv_iterkey(he, &len) ;
770	    Trace(("  Aborting Transaction [%d] in [%d] Active [%d]\n", tid->txn, tid, tid->active));
771	    if (tid->active) {
772#ifdef AT_LEAST_DB_4
773	    tid->txn->abort(tid->txn) ;
774#else
775	        txn_abort(tid->txn);
776#endif
777		++ closed ;
778	    }
779	    tid->active = FALSE ;
780	    ++ all ;
781	}
782	Trace(("End of BerkeleyDB::Term::close_all_txns aborted %d of %d transactios\n",closed, all)) ;
783    }
784
785    /* Close All Cursors */
786    {
787	BerkeleyDB__Cursor db ;
788	HE * he ;
789	I32 len ;
790	HV * hv = perl_get_hv("BerkeleyDB::Term::Cursor", TRUE);
791	int  all = 0 ;
792	int  closed = 0 ;
793	(void) hv_iterinit(hv) ;
794	Trace(("BerkeleyDB::Term::close_all_cursors \n")) ;
795	while ( (he = hv_iternext(hv)) ) {
796	    db = * (BerkeleyDB__Cursor*) hv_iterkey(he, &len) ;
797	    Trace(("  Closing Cursor [%d] in [%d] Active [%d]\n", db->cursor, db, db->active));
798	    if (db->active) {
799    	        ((db->cursor)->c_close)(db->cursor) ;
800		++ closed ;
801	    }
802	    db->active = FALSE ;
803	    ++ all ;
804	}
805	Trace(("End of BerkeleyDB::Term::close_all_cursors closed %d of %d cursors\n",closed, all)) ;
806    }
807
808    /* Close All Databases */
809    {
810	BerkeleyDB db ;
811	HE * he ;
812	I32 len ;
813	HV * hv = perl_get_hv("BerkeleyDB::Term::Db", TRUE);
814	int  all = 0 ;
815	int  closed = 0 ;
816	(void)hv_iterinit(hv) ;
817	Trace(("BerkeleyDB::Term::close_all_dbs\n" )) ;
818	while ( (he = hv_iternext(hv)) ) {
819	    db = * (BerkeleyDB*) hv_iterkey(he, &len) ;
820	    Trace(("  Closing Database [%d] in [%d] Active [%d]\n", db->dbp, db, db->active));
821	    if (db->active) {
822	        (db->dbp->close)(db->dbp, 0) ;
823		++ closed ;
824	    }
825	    db->active = FALSE ;
826	    ++ all ;
827	}
828	Trace(("End of BerkeleyDB::Term::close_all_dbs closed %d of %d dbs\n",closed, all)) ;
829    }
830
831    /* Close All Environments */
832    {
833	BerkeleyDB__Env env ;
834	HE * he ;
835	I32 len ;
836	HV * hv = perl_get_hv("BerkeleyDB::Term::Env", TRUE);
837	int  all = 0 ;
838	int  closed = 0 ;
839	(void)hv_iterinit(hv) ;
840	Trace(("BerkeleyDB::Term::close_all_envs\n")) ;
841	while ( (he = hv_iternext(hv)) ) {
842	    env = * (BerkeleyDB__Env*) hv_iterkey(he, &len) ;
843	    Trace(("  Closing Environment [%d] in [%d] Active [%d]\n", env->Env, env, env->active));
844	    if (env->active) {
845#if DB_VERSION_MAJOR == 2
846                db_appexit(env->Env) ;
847#else
848	        (env->Env->close)(env->Env, 0) ;
849#endif
850		++ closed ;
851	    }
852	    env->active = FALSE ;
853	    ++ all ;
854	}
855	Trace(("End of BerkeleyDB::Term::close_all_envs closed %d of %d dbs\n",closed, all)) ;
856    }
857
858    Trace(("end close_everything\n")) ;
859
860}
861
862static void
863destroyDB(BerkeleyDB db)
864{
865    dTHR;
866    if (! PL_dirty && db->active) {
867	if (db->parent_env && db->parent_env->open_dbs)
868	    -- db->parent_env->open_dbs ;
869      	-- db->open_cursors ;
870	((db->dbp)->close)(db->dbp, 0) ;
871    }
872    if (db->hash)
873       	  SvREFCNT_dec(db->hash) ;
874    if (db->compare)
875       	  SvREFCNT_dec(db->compare) ;
876    if (db->dup_compare)
877       	  SvREFCNT_dec(db->dup_compare) ;
878#ifdef AT_LEAST_DB_3_3
879    if (db->associated && !db->secondary_db)
880       	  SvREFCNT_dec(db->associated) ;
881#endif
882#ifdef AT_LEAST_DB_4_8
883    if (db->associated_foreign)
884       	  SvREFCNT_dec(db->associated_foreign) ;
885#endif
886    if (db->prefix)
887       	  SvREFCNT_dec(db->prefix) ;
888#ifdef DBM_FILTERING
889    if (db->filter_fetch_key)
890          SvREFCNT_dec(db->filter_fetch_key) ;
891    if (db->filter_store_key)
892          SvREFCNT_dec(db->filter_store_key) ;
893    if (db->filter_fetch_value)
894          SvREFCNT_dec(db->filter_fetch_value) ;
895    if (db->filter_store_value)
896          SvREFCNT_dec(db->filter_store_value) ;
897#endif
898    hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
899    if (db->filename)
900             Safefree(db->filename) ;
901    Safefree(db) ;
902}
903
904static int
905softCrash(const char *pat, ...)
906{
907    char buffer1 [500] ;
908    char buffer2 [500] ;
909    va_list args;
910    va_start(args, pat);
911
912    Trace(("softCrash: %s\n", pat)) ;
913
914#define ABORT_PREFIX "BerkeleyDB Aborting: "
915
916    /* buffer = (char*) safemalloc(strlen(pat) + strlen(ABORT_PREFIX) + 1) ; */
917    strcpy(buffer1, ABORT_PREFIX) ;
918    strcat(buffer1, pat) ;
919
920    vsprintf(buffer2, buffer1, args) ;
921
922    croak(buffer2);
923
924    /* NOTREACHED */
925    va_end(args);
926    return 1 ;
927}
928
929
930static I32
931GetArrayLength(BerkeleyDB db)
932{
933    DBT		key ;
934    DBT		value ;
935    int		RETVAL = 0 ;
936    DBC *   	cursor ;
937
938    DBT_clear(key) ;
939    DBT_clear(value) ;
940#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
941    if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor) == 0 )
942#else
943    if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor, 0) == 0 )
944#endif
945    {
946        RETVAL = cursor->c_get(cursor, &key, &value, DB_LAST) ;
947        if (RETVAL == 0)
948            RETVAL = *(I32 *)key.data ;
949        else /* No key means empty file */
950            RETVAL = 0 ;
951        cursor->c_close(cursor) ;
952    }
953
954    Trace(("GetArrayLength got %d\n", RETVAL)) ;
955    return ((I32)RETVAL) ;
956}
957
958#if 0
959
960#define GetRecnoKey(db, value)  _GetRecnoKey(db, value)
961
962static db_recno_t
963_GetRecnoKey(BerkeleyDB db, I32 value)
964{
965    Trace(("GetRecnoKey start value = %d\n", value)) ;
966    if (db->recno_or_queue && value < 0) {
967	/* Get the length of the array */
968	I32 length = GetArrayLength(db) ;
969
970	/* check for attempt to write before start of array */
971	if (length + value + RECNO_BASE <= 0)
972	    softCrash("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
973
974	value = length + value + RECNO_BASE ;
975    }
976    else
977        ++ value ;
978
979    Trace(("GetRecnoKey end value = %d\n", value)) ;
980
981    return value ;
982}
983
984#else /* ! 0 */
985
986#if 0
987#ifdef ALLOW_RECNO_OFFSET
988#define GetRecnoKey(db, value) _GetRecnoKey(db, value)
989
990static db_recno_t
991_GetRecnoKey(BerkeleyDB db, I32 value)
992{
993    if (value + RECNO_BASE < 1)
994	softCrash("key value %d < base (%d)", (value), RECNO_BASE?0:1) ;
995    return value + RECNO_BASE ;
996}
997
998#else
999#endif /* ALLOW_RECNO_OFFSET */
1000#endif /* 0 */
1001
1002#define GetRecnoKey(db, value) ((value) + RECNO_BASE )
1003
1004#endif /* 0 */
1005
1006#if 0
1007static SV *
1008GetInternalObject(SV * sv)
1009{
1010    SV * info = (SV*) NULL ;
1011    SV * s ;
1012    MAGIC * mg ;
1013
1014    Trace(("in GetInternalObject %d\n", sv)) ;
1015    if (sv == NULL || !SvROK(sv))
1016        return NULL ;
1017
1018    s = SvRV(sv) ;
1019    if (SvMAGICAL(s))
1020    {
1021        if (SvTYPE(s) == SVt_PVHV || SvTYPE(s) == SVt_PVAV)
1022            mg = mg_find(s, 'P') ;
1023        else
1024            mg = mg_find(s, 'q') ;
1025
1026	 /* all this testing is probably overkill, but till I know more
1027	    about global destruction it stays.
1028	 */
1029        /* if (mg && mg->mg_obj && SvRV(mg->mg_obj) && SvPVX(SvRV(mg->mg_obj))) */
1030        if (mg && mg->mg_obj && SvRV(mg->mg_obj) )
1031            info = SvRV(mg->mg_obj) ;
1032	else
1033	    info = s ;
1034    }
1035
1036    Trace(("end of GetInternalObject %d\n", info)) ;
1037    return info ;
1038}
1039#endif
1040
1041static int
1042btree_compare(DB_callback const DBT * key1, const DBT * key2 )
1043{
1044#ifdef dTHX
1045    dTHX;
1046#endif
1047    dSP ;
1048    dMY_CXT ;
1049    char * data1, * data2 ;
1050    int retval ;
1051    int count ;
1052    /* BerkeleyDB	keepDB = getCurrentDB ; */
1053
1054    Trace(("In btree_compare \n")) ;
1055    data1 = (char*) key1->data ;
1056    data2 = (char*) key2->data ;
1057
1058#ifndef newSVpvn
1059    /* As newSVpv will assume that the data pointer is a null terminated C
1060       string if the size parameter is 0, make sure that data points to an
1061       empty string if the length is 0
1062    */
1063    if (key1->size == 0)
1064        data1 = "" ;
1065    if (key2->size == 0)
1066        data2 = "" ;
1067#endif
1068
1069    ENTER ;
1070    SAVETMPS;
1071
1072    /* SAVESPTR(CurrentDB); */
1073
1074    PUSHMARK(SP) ;
1075    EXTEND(SP,2) ;
1076    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1077    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1078    PUTBACK ;
1079
1080    count = perl_call_sv(getCurrentDB->compare, G_SCALAR);
1081
1082    SPAGAIN ;
1083
1084    if (count != 1)
1085        softCrash ("in btree_compare - expected 1 return value from compare sub, got %d", count) ;
1086
1087    retval = POPi ;
1088
1089    PUTBACK ;
1090    FREETMPS ;
1091    LEAVE ;
1092    /* CurrentDB = keepDB ; */
1093    return (retval) ;
1094
1095}
1096
1097static int
1098dup_compare(DB_callback const DBT * key1, const DBT * key2 )
1099{
1100#ifdef dTHX
1101    dTHX;
1102#endif
1103    dSP ;
1104    dMY_CXT ;
1105    char * data1, * data2 ;
1106    int retval ;
1107    int count ;
1108    /* BerkeleyDB	keepDB = CurrentDB ; */
1109
1110    Trace(("In dup_compare \n")) ;
1111    if (!getCurrentDB)
1112	    softCrash("Internal Error - No CurrentDB in dup_compare") ;
1113    if (getCurrentDB->dup_compare == NULL)
1114
1115
1116        softCrash("in dup_compare: no callback specified for database '%s'", getCurrentDB->filename) ;
1117
1118    data1 = (char*) key1->data ;
1119    data2 = (char*) key2->data ;
1120
1121#ifndef newSVpvn
1122    /* As newSVpv will assume that the data pointer is a null terminated C
1123       string if the size parameter is 0, make sure that data points to an
1124       empty string if the length is 0
1125    */
1126    if (key1->size == 0)
1127        data1 = "" ;
1128    if (key2->size == 0)
1129        data2 = "" ;
1130#endif
1131
1132    ENTER ;
1133    SAVETMPS;
1134
1135    PUSHMARK(SP) ;
1136    EXTEND(SP,2) ;
1137    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1138    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1139    PUTBACK ;
1140
1141    count = perl_call_sv(getCurrentDB->dup_compare, G_SCALAR);
1142
1143    SPAGAIN ;
1144
1145    if (count != 1)
1146        softCrash ("dup_compare: expected 1 return value from compare sub, got %d", count) ;
1147
1148    retval = POPi ;
1149
1150    PUTBACK ;
1151    FREETMPS ;
1152    LEAVE ;
1153    /* CurrentDB = keepDB ; */
1154    return (retval) ;
1155
1156}
1157
1158static size_t
1159btree_prefix(DB_callback const DBT * key1, const DBT * key2 )
1160{
1161#ifdef dTHX
1162    dTHX;
1163#endif
1164    dSP ;
1165    dMY_CXT ;
1166    char * data1, * data2 ;
1167    int retval ;
1168    int count ;
1169    /* BerkeleyDB	keepDB = CurrentDB ; */
1170
1171    Trace(("In btree_prefix \n")) ;
1172    data1 = (char*) key1->data ;
1173    data2 = (char*) key2->data ;
1174
1175#ifndef newSVpvn
1176    /* As newSVpv will assume that the data pointer is a null terminated C
1177       string if the size parameter is 0, make sure that data points to an
1178       empty string if the length is 0
1179    */
1180    if (key1->size == 0)
1181        data1 = "" ;
1182    if (key2->size == 0)
1183        data2 = "" ;
1184#endif
1185
1186    ENTER ;
1187    SAVETMPS;
1188
1189    PUSHMARK(SP) ;
1190    EXTEND(SP,2) ;
1191    PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1192    PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1193    PUTBACK ;
1194
1195    count = perl_call_sv(getCurrentDB->prefix, G_SCALAR);
1196
1197    SPAGAIN ;
1198
1199    if (count != 1)
1200        softCrash ("btree_prefix: expected 1 return value from prefix sub, got %d", count) ;
1201
1202    retval = POPi ;
1203
1204    PUTBACK ;
1205    FREETMPS ;
1206    LEAVE ;
1207    /* CurrentDB = keepDB ; */
1208
1209    return (retval) ;
1210}
1211
1212static u_int32_t
1213hash_cb(DB_callback const void * data, u_int32_t size)
1214{
1215#ifdef dTHX
1216    dTHX;
1217#endif
1218    dSP ;
1219    dMY_CXT ;
1220    int retval ;
1221    int count ;
1222    /* BerkeleyDB	keepDB = CurrentDB ; */
1223
1224    Trace(("In hash_cb \n")) ;
1225#ifndef newSVpvn
1226    if (size == 0)
1227        data = "" ;
1228#endif
1229
1230    ENTER ;
1231    SAVETMPS;
1232
1233    PUSHMARK(SP) ;
1234
1235    XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
1236    PUTBACK ;
1237
1238    count = perl_call_sv(getCurrentDB->hash, G_SCALAR);
1239
1240    SPAGAIN ;
1241
1242    if (count != 1)
1243        softCrash ("hash_cb: expected 1 return value from hash sub, got %d", count) ;
1244
1245    retval = POPi ;
1246
1247    PUTBACK ;
1248    FREETMPS ;
1249    LEAVE ;
1250    /* CurrentDB = keepDB ; */
1251
1252    return (retval) ;
1253}
1254
1255#ifdef AT_LEAST_DB_3_3
1256
1257static int
1258associate_cb(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
1259{
1260#ifdef dTHX
1261    dTHX;
1262#endif
1263    dSP ;
1264    dMY_CXT ;
1265    char * pk_dat, * pd_dat ;
1266    /* char *sk_dat ; */
1267    int retval ;
1268    int count ;
1269    int i ;
1270    SV * skey_SV ;
1271    STRLEN skey_len;
1272    char * skey_ptr ;
1273    AV * skey_AV;
1274    DBT * tkey;
1275
1276    Trace(("In associate_cb \n")) ;
1277    if (getCurrentDB->associated == NULL){
1278        Trace(("No Callback registered\n")) ;
1279        return EINVAL ;
1280    }
1281
1282    skey_SV = newSVpv("",0);
1283
1284
1285    pk_dat = (char*) pkey->data ;
1286    pd_dat = (char*) pdata->data ;
1287
1288#ifndef newSVpvn
1289    /* As newSVpv will assume that the data pointer is a null terminated C
1290       string if the size parameter is 0, make sure that data points to an
1291       empty string if the length is 0
1292    */
1293    if (pkey->size == 0)
1294        pk_dat = "" ;
1295    if (pdata->size == 0)
1296        pd_dat = "" ;
1297#endif
1298
1299    ENTER ;
1300    SAVETMPS;
1301
1302    PUSHMARK(SP) ;
1303    EXTEND(SP,3) ;
1304    PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
1305    PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
1306    PUSHs(sv_2mortal(skey_SV));
1307    PUTBACK ;
1308
1309    Trace(("calling associated cb\n"));
1310    count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
1311    Trace(("called associated cb\n"));
1312
1313    SPAGAIN ;
1314
1315    if (count != 1)
1316        softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;
1317
1318    retval = POPi ;
1319
1320    PUTBACK ;
1321
1322    if (retval != DB_DONOTINDEX)
1323    {
1324        /* retrieve the secondary key */
1325        DBT_clear(*skey);
1326
1327        skey->flags = DB_DBT_APPMALLOC;
1328
1329    #ifdef AT_LEAST_DB_4_6
1330        if ( SvROK(skey_SV) ) {
1331            SV *rv = SvRV(skey_SV);
1332
1333            if ( SvTYPE(rv) == SVt_PVAV ) {
1334                AV *av = (AV *)rv;
1335                SV **svs = AvARRAY(av);
1336                I32 len = av_len(av) + 1;
1337                I32 i;
1338                DBT *dbts;
1339
1340                if ( len == 0 ) {
1341                    retval = DB_DONOTINDEX;
1342                } else if ( len == 1 ) {
1343                    skey_ptr = SvPV(svs[0], skey_len);
1344                    skey->size = skey_len;
1345                    skey->data = (char*)safemalloc(skey_len);
1346                    memcpy(skey->data, skey_ptr, skey_len);
1347                    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1348                } else {
1349                    skey->flags |= DB_DBT_MULTIPLE ;
1350
1351                    /* FIXME this will leak if safemalloc fails later... do we care? */
1352                    dbts = (DBT *) safemalloc(sizeof(DBT) * len);
1353                    skey->size = len;
1354                    skey->data = (char *)dbts;
1355
1356                    for ( i = 0; i < skey->size; i ++ ) {
1357                        skey_ptr = SvPV(svs[i], skey_len);
1358
1359                        dbts[i].flags = DB_DBT_APPMALLOC;
1360                        dbts[i].size = skey_len;
1361                        dbts[i].data = (char *)safemalloc(skey_len);
1362                        memcpy(dbts[i].data, skey_ptr, skey_len);
1363
1364                        Trace(("key is %d -- %.*s\n", dbts[i].size, dbts[i].size, dbts[i].data));
1365                    }
1366                    Trace(("mkey has %d subkeys\n", skey->size));
1367                }
1368            } else {
1369                croak("Not an array reference");
1370            }
1371        } else
1372    #endif
1373        {
1374            skey_ptr = SvPV(skey_SV, skey_len);
1375            /* skey->size = SvCUR(skey_SV); */
1376            /* skey->data = (char*)safemalloc(skey->size); */
1377            skey->size = skey_len;
1378            skey->data = (char*)safemalloc(skey_len);
1379            memcpy(skey->data, skey_ptr, skey_len);
1380        }
1381    }
1382    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1383
1384    FREETMPS ;
1385    LEAVE ;
1386
1387    return (retval) ;
1388}
1389
1390static int
1391associate_cb_recno(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
1392{
1393#ifdef dTHX
1394    dTHX;
1395#endif
1396    dSP ;
1397    dMY_CXT ;
1398    char * pk_dat, * pd_dat ;
1399    /* char *sk_dat ; */
1400    int retval ;
1401    int count ;
1402    SV * skey_SV ;
1403    STRLEN skey_len;
1404    char * skey_ptr ;
1405    /* db_recno_t Value; */
1406
1407    Trace(("In associate_cb_recno \n")) ;
1408    if (getCurrentDB->associated == NULL){
1409        Trace(("No Callback registered\n")) ;
1410        return EINVAL ;
1411    }
1412
1413    skey_SV = newSVpv("",0);
1414
1415
1416    pk_dat = (char*) pkey->data ;
1417    pd_dat = (char*) pdata->data ;
1418
1419#ifndef newSVpvn
1420    /* As newSVpv will assume that the data pointer is a null terminated C
1421       string if the size parameter is 0, make sure that data points to an
1422       empty string if the length is 0
1423    */
1424    if (pkey->size == 0)
1425        pk_dat = "" ;
1426    if (pdata->size == 0)
1427        pd_dat = "" ;
1428#endif
1429
1430    ENTER ;
1431    SAVETMPS;
1432
1433    PUSHMARK(SP) ;
1434    EXTEND(SP,2) ;
1435    PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
1436    PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
1437    PUSHs(sv_2mortal(skey_SV));
1438    PUTBACK ;
1439
1440    Trace(("calling associated cb\n"));
1441    count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
1442    Trace(("called associated cb\n"));
1443
1444    SPAGAIN ;
1445
1446    if (count != 1)
1447        softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;
1448
1449    retval = POPi ;
1450
1451    PUTBACK ;
1452
1453    /* retrieve the secondary key */
1454    DBT_clear(*skey);
1455
1456    if (retval != DB_DONOTINDEX)
1457    {
1458        Value = GetRecnoKey(getCurrentDB, SvIV(skey_SV)) ;
1459        skey->flags = DB_DBT_APPMALLOC;
1460        skey->size = (int)sizeof(db_recno_t);
1461        skey->data = (char*)safemalloc(skey->size);
1462        memcpy(skey->data, &Value, skey->size);
1463    }
1464
1465    FREETMPS ;
1466    LEAVE ;
1467
1468    return (retval) ;
1469}
1470
1471#endif /* AT_LEAST_DB_3_3 */
1472
1473#ifdef AT_LEAST_DB_4_8
1474
1475typedef int (*bt_compress_fcn_type)(DB *db, const DBT *prevKey,
1476        const DBT *prevData, const DBT *key, const DBT *data, DBT *dest);
1477
1478typedef int (*bt_decompress_fcn_type)(DB *db, const DBT *prevKey,
1479        const DBT *prevData, DBT *compressed, DBT *destKey, DBT *destData);
1480
1481#endif /* AT_LEAST_DB_4_8 */
1482
1483typedef int (*foreign_cb_type)(DB *, const DBT *, DBT *, const DBT *, int *) ;
1484
1485#ifdef AT_LEAST_DB_4_8
1486
1487static int
1488associate_foreign_cb(DB* db, const DBT * key, DBT * data, DBT * foreignkey, int* changed)
1489{
1490#ifdef dTHX
1491    dTHX;
1492#endif
1493    dSP ;
1494    dMY_CXT ;
1495    char * k_dat, * d_dat, * f_dat;
1496    int retval ;
1497    int count ;
1498    int i ;
1499    SV * changed_SV ;
1500    STRLEN skey_len;
1501    char * skey_ptr ;
1502    AV * skey_AV;
1503    DBT * tkey;
1504
1505    Trace(("In associate_foreign_cb \n")) ;
1506    if (getCurrentDB->associated_foreign == NULL){
1507        Trace(("No Callback registered\n")) ;
1508        return EINVAL ;
1509    }
1510
1511    changed_SV = newSViv(*changed);
1512
1513
1514    k_dat = (char*) key->data ;
1515    d_dat = (char*) data->data ;
1516    f_dat = (char*) foreignkey->data ;
1517
1518#ifndef newSVpvn
1519    /* As newSVpv will assume that the data pointer is a null terminated C
1520       string if the size parameter is 0, make sure that data points to an
1521       empty string if the length is 0
1522    */
1523    if (key->size == 0)
1524        k_dat = "" ;
1525    if (data->size == 0)
1526        d_dat = "" ;
1527    if (foreignkey->size == 0)
1528        f_dat = "" ;
1529#endif
1530
1531    ENTER ;
1532    SAVETMPS;
1533
1534    PUSHMARK(SP) ;
1535    EXTEND(SP,4) ;
1536
1537    PUSHs(sv_2mortal(newSVpvn(k_dat,key->size)));
1538    SV* data_sv = newSVpv(d_dat, data->size);
1539    PUSHs(sv_2mortal(data_sv));
1540    PUSHs(sv_2mortal(newSVpvn(f_dat,foreignkey->size)));
1541    PUSHs(sv_2mortal(changed_SV));
1542    PUTBACK ;
1543
1544    Trace(("calling associated cb\n"));
1545    count = perl_call_sv(getCurrentDB->associated_foreign, G_SCALAR);
1546    Trace(("called associated cb\n"));
1547
1548    SPAGAIN ;
1549
1550    if (count != 1)
1551        softCrash ("associate_foreign: expected 1 return value from prefix sub, got %d", count) ;
1552
1553    retval = POPi ;
1554
1555    PUTBACK ;
1556
1557    *changed = SvIV(changed_SV);
1558
1559    if (*changed)
1560    {
1561        DBT_clear(*data);
1562        data->flags = DB_DBT_APPMALLOC;
1563        skey_ptr = SvPV(data_sv, skey_len);
1564        data->size = skey_len;
1565        data->data = (char*)safemalloc(skey_len);
1566        memcpy(data->data, skey_ptr, skey_len);
1567    }
1568    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1569
1570    FREETMPS ;
1571    LEAVE ;
1572
1573    return (retval) ;
1574}
1575
1576static int
1577associate_foreign_cb_recno(DB* db, const DBT * key, DBT * data, DBT * foreignkey, int* changed)
1578{
1579#ifdef dTHX
1580    dTHX;
1581#endif
1582    dSP ;
1583    dMY_CXT ;
1584    char * k_dat, * d_dat, * f_dat;
1585    int retval ;
1586    int count ;
1587    int i ;
1588    SV * changed_SV ;
1589    STRLEN skey_len;
1590    char * skey_ptr ;
1591    AV * skey_AV;
1592    DBT * tkey;
1593
1594    Trace(("In associate_foreign_cb \n")) ;
1595    if (getCurrentDB->associated_foreign == NULL){
1596        Trace(("No Callback registered\n")) ;
1597        return EINVAL ;
1598    }
1599
1600    changed_SV = newSViv(*changed);
1601
1602
1603    k_dat = (char*) key->data ;
1604    d_dat = (char*) data->data ;
1605    f_dat = (char*) foreignkey->data ;
1606
1607#ifndef newSVpvn
1608    /* As newSVpv will assume that the data pointer is a null terminated C
1609       string if the size parameter is 0, make sure that data points to an
1610       empty string if the length is 0
1611    */
1612    if (key->size == 0)
1613        k_dat = "" ;
1614    if (data->size == 0)
1615        d_dat = "" ;
1616    if (foreignkey->size == 0)
1617        f_dat = "" ;
1618#endif
1619
1620    ENTER ;
1621    SAVETMPS;
1622
1623    PUSHMARK(SP) ;
1624    EXTEND(SP,4) ;
1625
1626    PUSHs(sv_2mortal(newSVpvn(k_dat,key->size)));
1627    SV* data_sv = newSVpv(d_dat, data->size);
1628    PUSHs(sv_2mortal(data_sv));
1629    PUSHs(sv_2mortal(newSVpvn(f_dat,foreignkey->size)));
1630    PUSHs(sv_2mortal(changed_SV));
1631    PUTBACK ;
1632
1633    Trace(("calling associated cb\n"));
1634    count = perl_call_sv(getCurrentDB->associated_foreign, G_SCALAR);
1635    Trace(("called associated cb\n"));
1636
1637    SPAGAIN ;
1638
1639    if (count != 1)
1640        softCrash ("associate_foreign: expected 1 return value from prefix sub, got %d", count) ;
1641
1642    retval = POPi ;
1643
1644    PUTBACK ;
1645
1646    *changed = SvIV(changed_SV);
1647
1648    if (*changed)
1649    {
1650        DBT_clear(*data);
1651        Value = GetRecnoKey(getCurrentDB, SvIV(data_sv)) ;
1652        data->flags = DB_DBT_APPMALLOC;
1653        data->size = (int)sizeof(db_recno_t);
1654        data->data = (char*)safemalloc(data->size);
1655        memcpy(data->data, &Value, data->size);
1656    }
1657    Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1658
1659    FREETMPS ;
1660    LEAVE ;
1661
1662    return (retval) ;
1663}
1664
1665#endif /* AT_LEAST_DB_3_3 */
1666
1667static void
1668#ifdef AT_LEAST_DB_4_3
1669db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
1670#else
1671db_errcall_cb(const char * db_errpfx, char * buffer)
1672#endif
1673{
1674    SV * sv;
1675
1676    Trace(("In errcall_cb \n")) ;
1677#if 0
1678
1679    if (db_errpfx == NULL)
1680	db_errpfx = "" ;
1681    if (buffer == NULL )
1682	buffer = "" ;
1683    ErrBuff[0] = '\0';
1684    if (strlen(db_errpfx) + strlen(buffer) + 3 <= 1000) {
1685	if (*db_errpfx != '\0') {
1686	    strcat(ErrBuff, db_errpfx) ;
1687	    strcat(ErrBuff, ": ") ;
1688	}
1689	strcat(ErrBuff, buffer) ;
1690    }
1691
1692#endif
1693
1694    sv = perl_get_sv(ERR_BUFF, FALSE) ;
1695    if (sv) {
1696        if (db_errpfx)
1697	    sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
1698        else
1699            sv_setpv(sv, buffer) ;
1700    }
1701}
1702
1703#if defined(AT_LEAST_DB_4_4) && ! defined(_WIN32)
1704
1705int
1706db_isalive_cb(DB_ENV *dbenv, pid_t pid, db_threadid_t tid, u_int32_t flags)
1707{
1708  bool processAlive = ( kill(pid, 0) == 0 ) || ( errno != ESRCH );
1709  return processAlive;
1710}
1711
1712#endif
1713
1714
1715static SV *
1716readHash(HV * hash, char * key)
1717{
1718    SV **       svp;
1719    svp = hv_fetch(hash, key, strlen(key), FALSE);
1720    if (svp && SvOK(*svp))
1721        return *svp ;
1722    return NULL ;
1723}
1724
1725static void
1726hash_delete(char * hash, char * key)
1727{
1728    HV * hv = perl_get_hv(hash, TRUE);
1729    (void) hv_delete(hv, (char*)&key, sizeof(key), G_DISCARD);
1730}
1731
1732static void
1733hash_store_iv(char * hash, char * key, IV value)
1734{
1735    HV * hv = perl_get_hv(hash, TRUE);
1736    (void)hv_store(hv, (char*)&key, sizeof(key), newSViv(value), 0);
1737    /* printf("hv_store returned %d\n", ret) ; */
1738}
1739
1740static void
1741hv_store_iv(HV * hash, char * key, IV value)
1742{
1743    hv_store(hash, key, strlen(key), newSViv(value), 0);
1744}
1745
1746#if 0
1747static void
1748hv_store_uv(HV * hash, char * key, UV value)
1749{
1750    hv_store(hash, key, strlen(key), newSVuv(value), 0);
1751}
1752#endif
1753
1754static void
1755GetKey(BerkeleyDB_type * db, SV * sv, DBTKEY * key)
1756{
1757    dMY_CXT ;
1758    if (db->recno_or_queue) {
1759        Value = GetRecnoKey(db, SvIV(sv)) ;
1760        key->data = & Value;
1761        key->size = (int)sizeof(db_recno_t);
1762    }
1763    else {
1764        key->data = SvPV(sv, PL_na);
1765        key->size = (int)PL_na;
1766    }
1767}
1768
1769static BerkeleyDB
1770my_db_open(
1771		BerkeleyDB	db ,
1772		SV * 		ref,
1773		SV *		ref_dbenv ,
1774		BerkeleyDB__Env	dbenv ,
1775    	    	BerkeleyDB__Txn txn,
1776		const char *	file,
1777		const char *	subname,
1778		DBTYPE		type,
1779		int		flags,
1780		int		mode,
1781		DB_INFO * 	info,
1782		char *		password,
1783		int		enc_flags,
1784        HV*     hash
1785	)
1786{
1787    DB_ENV *	env    = NULL ;
1788    BerkeleyDB 	RETVAL = NULL ;
1789    DB *	dbp ;
1790    int		Status ;
1791    DB_TXN* 	txnid = NULL ;
1792    dMY_CXT;
1793
1794    Trace(("_db_open(dbenv[%p] ref_dbenv [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
1795		dbenv, ref_dbenv, file, subname, type, flags, mode)) ;
1796
1797
1798    if (dbenv)
1799	env = dbenv->Env ;
1800
1801    if (txn)
1802        txnid = txn->txn;
1803
1804    Trace(("_db_open(dbenv[%p] ref_dbenv [%p] txn [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
1805		dbenv, ref_dbenv, txn, file, subname, type, flags, mode)) ;
1806
1807#if DB_VERSION_MAJOR == 2
1808    if (subname)
1809        softCrash("Subname needs Berkeley DB 3 or better") ;
1810#endif
1811
1812#ifndef AT_LEAST_DB_4_1
1813	    if (password)
1814	        softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
1815#endif /* ! AT_LEAST_DB_4_1 */
1816
1817#ifndef AT_LEAST_DB_3_2
1818    CurrentDB = db ;
1819#endif
1820
1821#if DB_VERSION_MAJOR > 2
1822    Trace(("creating\n"));
1823    Status = db_create(&dbp, env, 0) ;
1824    Trace(("db_create returned %s\n", my_db_strerror(Status))) ;
1825    if (Status)
1826        return RETVAL ;
1827
1828#ifdef AT_LEAST_DB_3_2
1829	dbp->BackRef = db;
1830#endif
1831
1832#ifdef AT_LEAST_DB_3_3
1833    if (! env) {
1834	dbp->set_alloc(dbp, safemalloc, MyRealloc, safefree) ;
1835	dbp->set_errcall(dbp, db_errcall_cb) ;
1836    }
1837#endif
1838
1839    {
1840        /* Btree Compression */
1841        SV* sv;
1842        SV* wanted = NULL;
1843
1844	    SetValue_sv(wanted, "set_bt_compress") ;
1845
1846        if (wanted)
1847        {
1848#ifndef AT_LEAST_DB_4_8
1849            softCrash("set_bt_compress needs Berkeley DB 4.8 or better") ;
1850#else
1851            bt_compress_fcn_type c = NULL;
1852            bt_decompress_fcn_type u = NULL;
1853            /*
1854            SV* compress = NULL;
1855            SV* uncompress = NULL;
1856
1857            SetValue_sv(compress, "_btcompress1") ;
1858            SetValue_sv(uncompress, "_btcompress2") ;
1859            if (compress)
1860            {
1861                c = ;
1862                db->bt_compress = newSVsv(compress) ;
1863            }
1864            */
1865
1866            Status = dbp->set_bt_compress(dbp, c, u);
1867
1868            if (Status)
1869                return RETVAL ;
1870#endif /* AT_LEAST_DB_4_8 */
1871        }
1872    }
1873
1874#ifdef AT_LEAST_DB_4_1
1875    /* set encryption */
1876    if (password)
1877    {
1878        Status = dbp->set_encrypt(dbp, password, enc_flags);
1879        Trace(("DB->set_encrypt passwd = %s, flags %d returned %s\n",
1880			      		password, enc_flags,
1881  					my_db_strerror(Status))) ;
1882         if (Status)
1883              return RETVAL ;
1884    }
1885#endif
1886
1887    if (info->re_source) {
1888        Status = dbp->set_re_source(dbp, info->re_source) ;
1889	Trace(("set_re_source [%s] returned %s\n",
1890		info->re_source, my_db_strerror(Status)));
1891        if (Status)
1892            return RETVAL ;
1893    }
1894
1895    if (info->db_cachesize) {
1896        Status = dbp->set_cachesize(dbp, 0, info->db_cachesize, 0) ;
1897	Trace(("set_cachesize [%d] returned %s\n",
1898		info->db_cachesize, my_db_strerror(Status)));
1899        if (Status)
1900            return RETVAL ;
1901    }
1902
1903    if (info->db_lorder) {
1904        Status = dbp->set_lorder(dbp, info->db_lorder) ;
1905	Trace(("set_lorder [%d] returned %s\n",
1906		info->db_lorder, my_db_strerror(Status)));
1907        if (Status)
1908            return RETVAL ;
1909    }
1910
1911    if (info->db_pagesize) {
1912        Status = dbp->set_pagesize(dbp, info->db_pagesize) ;
1913	Trace(("set_pagesize [%d] returned %s\n",
1914		info->db_pagesize, my_db_strerror(Status)));
1915        if (Status)
1916            return RETVAL ;
1917    }
1918
1919    if (info->h_ffactor) {
1920        Status = dbp->set_h_ffactor(dbp, info->h_ffactor) ;
1921	Trace(("set_h_ffactor [%d] returned %s\n",
1922		info->h_ffactor, my_db_strerror(Status)));
1923        if (Status)
1924            return RETVAL ;
1925    }
1926
1927    if (info->h_nelem) {
1928        Status = dbp->set_h_nelem(dbp, info->h_nelem) ;
1929	Trace(("set_h_nelem [%d] returned %s\n",
1930		info->h_nelem, my_db_strerror(Status)));
1931        if (Status)
1932            return RETVAL ;
1933    }
1934
1935    if (info->bt_minkey) {
1936        Status = dbp->set_bt_minkey(dbp, info->bt_minkey) ;
1937	Trace(("set_bt_minkey [%d] returned %s\n",
1938		info->bt_minkey, my_db_strerror(Status)));
1939        if (Status)
1940            return RETVAL ;
1941    }
1942
1943    if (info->bt_compare) {
1944        Status = dbp->set_bt_compare(dbp, info->bt_compare) ;
1945	Trace(("set_bt_compare [%p] returned %s\n",
1946		info->bt_compare, my_db_strerror(Status)));
1947        if (Status)
1948            return RETVAL ;
1949    }
1950
1951    if (info->h_hash) {
1952        Status = dbp->set_h_hash(dbp, info->h_hash) ;
1953	Trace(("set_h_hash [%d] returned %s\n",
1954		info->h_hash, my_db_strerror(Status)));
1955        if (Status)
1956            return RETVAL ;
1957    }
1958
1959
1960    if (info->dup_compare) {
1961        Status = dbp->set_dup_compare(dbp, info->dup_compare) ;
1962	Trace(("set_dup_compare [%d] returned %s\n",
1963		info->dup_compare, my_db_strerror(Status)));
1964        if (Status)
1965            return RETVAL ;
1966    }
1967
1968    if (info->bt_prefix) {
1969        Status = dbp->set_bt_prefix(dbp, info->bt_prefix) ;
1970	Trace(("set_bt_prefix [%d] returned %s\n",
1971		info->bt_prefix, my_db_strerror(Status)));
1972        if (Status)
1973            return RETVAL ;
1974    }
1975
1976    if (info->re_len) {
1977        Status = dbp->set_re_len(dbp, info->re_len) ;
1978	Trace(("set_re_len [%d] returned %s\n",
1979		info->re_len, my_db_strerror(Status)));
1980        if (Status)
1981            return RETVAL ;
1982    }
1983
1984    if (info->re_delim) {
1985        Status = dbp->set_re_delim(dbp, info->re_delim) ;
1986	Trace(("set_re_delim [%d] returned %s\n",
1987		info->re_delim, my_db_strerror(Status)));
1988        if (Status)
1989            return RETVAL ;
1990    }
1991
1992    if (info->re_pad) {
1993        Status = dbp->set_re_pad(dbp, info->re_pad) ;
1994	Trace(("set_re_pad [%d] returned %s\n",
1995		info->re_pad, my_db_strerror(Status)));
1996        if (Status)
1997            return RETVAL ;
1998    }
1999
2000    if (info->flags) {
2001        Status = dbp->set_flags(dbp, info->flags) ;
2002	Trace(("set_flags [%d] returned %s\n",
2003		info->flags, my_db_strerror(Status)));
2004        if (Status)
2005            return RETVAL ;
2006    }
2007
2008    if (info->q_extentsize) {
2009#ifdef AT_LEAST_DB_3_2
2010        Status = dbp->set_q_extentsize(dbp, info->q_extentsize) ;
2011	Trace(("set_q_extentsize [%d] returned %s\n",
2012		info->q_extentsize, my_db_strerror(Status)));
2013        if (Status)
2014            return RETVAL ;
2015#else
2016        softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ;
2017#endif
2018    }
2019
2020    /* In-memory database need DB_CREATE from 4.4 */
2021    if (! file)
2022        flags |= DB_CREATE;
2023
2024	Trace(("db_open'ing\n"));
2025
2026#ifdef AT_LEAST_DB_4_1
2027    if ((Status = (dbp->open)(dbp, txnid, file, subname, type, flags, mode)) == 0) {
2028#else
2029    if ((Status = (dbp->open)(dbp, file, subname, type, flags, mode)) == 0) {
2030#endif /* AT_LEAST_DB_4_1 */
2031#else /* DB_VERSION_MAJOR == 2 */
2032    if ((Status = db_open(file, type, flags, mode, env, info, &dbp)) == 0) {
2033        CurrentDB = db ;
2034#endif /* DB_VERSION_MAJOR == 2 */
2035
2036
2037	Trace(("db_opened ok\n"));
2038	RETVAL = db ;
2039	RETVAL->dbp  = dbp ;
2040	RETVAL->txn  = txnid ;
2041#if DB_VERSION_MAJOR == 2
2042    	RETVAL->type = dbp->type ;
2043#else /* DB_VERSION_MAJOR > 2 */
2044#ifdef AT_LEAST_DB_3_3
2045    	dbp->get_type(dbp, &RETVAL->type) ;
2046#else /* DB 3.0 -> 3.2 */
2047    	RETVAL->type = dbp->get_type(dbp) ;
2048#endif
2049#endif /* DB_VERSION_MAJOR > 2 */
2050    	RETVAL->primary_recno_or_queue = FALSE;
2051    	RETVAL->recno_or_queue = (RETVAL->type == DB_RECNO ||
2052	                          RETVAL->type == DB_QUEUE) ;
2053	RETVAL->filename = my_strdup(file) ;
2054	RETVAL->Status = Status ;
2055	RETVAL->active = TRUE ;
2056	hash_store_iv("BerkeleyDB::Term::Db", (char *)RETVAL, 1) ;
2057	Trace(("  storing %p %p in BerkeleyDB::Term::Db\n", RETVAL, dbp)) ;
2058	if (dbenv) {
2059	    RETVAL->cds_enabled = dbenv->cds_enabled ;
2060	    RETVAL->parent_env = dbenv ;
2061	    dbenv->Status = Status ;
2062	    ++ dbenv->open_dbs ;
2063	}
2064    }
2065    else {
2066#if DB_VERSION_MAJOR > 2
2067	(dbp->close)(dbp, 0) ;
2068#endif
2069	destroyDB(db) ;
2070        Trace(("db open returned %s\n", my_db_strerror(Status))) ;
2071    }
2072
2073    Trace(("End of _db_open\n"));
2074    return RETVAL ;
2075}
2076
2077
2078#include "constants.h"
2079
2080MODULE = BerkeleyDB		PACKAGE = BerkeleyDB	PREFIX = env_
2081
2082INCLUDE: constants.xs
2083
2084#define env_db_version(maj, min, patch) 	db_version(&maj, &min, &patch)
2085char *
2086env_db_version(maj, min, patch)
2087	int  maj
2088	int  min
2089	int  patch
2090	PREINIT:
2091	  dMY_CXT;
2092	OUTPUT:
2093	  RETVAL
2094	  maj
2095	  min
2096	  patch
2097
2098int
2099db_value_set(value, which)
2100	int value
2101	int which
2102        NOT_IMPLEMENTED_YET
2103
2104
2105DualType
2106_db_remove(ref)
2107	SV * 		ref
2108	PREINIT:
2109	  dMY_CXT;
2110	CODE:
2111	{
2112#if DB_VERSION_MAJOR == 2
2113	    softCrash("BerkeleyDB::db_remove needs Berkeley DB 3.x or better") ;
2114#else
2115	    HV *		hash ;
2116    	    DB *		dbp ;
2117	    SV * 		sv ;
2118	    const char *	db = NULL ;
2119	    const char *	subdb 	= NULL ;
2120	    BerkeleyDB__Env	env 	= NULL ;
2121	    BerkeleyDB__Txn	txn 	= NULL ;
2122    	    DB_ENV *		dbenv   = NULL ;
2123	    u_int32_t		flags	= 0 ;
2124
2125	    hash = (HV*) SvRV(ref) ;
2126	    SetValue_pv(db,    "Filename", char *) ;
2127	    SetValue_pv(subdb, "Subname", char *) ;
2128	    SetValue_iv(flags, "Flags") ;
2129	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2130            if (txn) {
2131#ifdef AT_LEAST_DB_4_1
2132                if (!env)
2133                    softCrash("transactional db_remove requires an environment");
2134                RETVAL = env->Status = env->Env->dbremove(env->Env, txn->txn, db, subdb, flags);
2135#else
2136                softCrash("transactional db_remove requires Berkeley DB 4.1 or better");
2137#endif
2138            } else {
2139                if (env)
2140                    dbenv = env->Env ;
2141                RETVAL = db_create(&dbp, dbenv, 0) ;
2142                if (RETVAL == 0) {
2143                    RETVAL = dbp->remove(dbp, db, subdb, flags) ;
2144            }
2145        }
2146#endif
2147	}
2148	OUTPUT:
2149	    RETVAL
2150
2151DualType
2152_db_verify(ref)
2153	SV * 		ref
2154	PREINIT:
2155	  dMY_CXT;
2156	CODE:
2157	{
2158#ifndef AT_LEAST_DB_3_1
2159	    softCrash("BerkeleyDB::db_verify needs Berkeley DB 3.1.x or better") ;
2160#else
2161	    HV *		hash ;
2162    	    DB *		dbp ;
2163	    SV * 		sv ;
2164	    const char *	db = NULL ;
2165	    const char *	subdb 	= NULL ;
2166	    const char *	outfile	= NULL ;
2167	    FILE *		ofh = NULL;
2168	    BerkeleyDB__Env	env 	= NULL ;
2169    	    DB_ENV *		dbenv   = NULL ;
2170	    u_int32_t		flags	= 0 ;
2171
2172	    hash = (HV*) SvRV(ref) ;
2173	    SetValue_pv(db,    "Filename", char *) ;
2174	    SetValue_pv(subdb, "Subname", char *) ;
2175	    SetValue_pv(outfile, "Outfile", char *) ;
2176	    SetValue_iv(flags, "Flags") ;
2177	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2178            RETVAL = 0;
2179            if (outfile){
2180	        ofh = fopen(outfile, "w");
2181                if (! ofh)
2182                    RETVAL = errno;
2183            }
2184            if (! RETVAL) {
2185    	        if (env)
2186		    dbenv = env->Env ;
2187                RETVAL = db_create(&dbp, dbenv, 0) ;
2188	        if (RETVAL == 0) {
2189	            RETVAL = dbp->verify(dbp, db, subdb, ofh, flags) ;
2190	        }
2191	        if (outfile)
2192                    fclose(ofh);
2193            }
2194#endif
2195	}
2196	OUTPUT:
2197	    RETVAL
2198
2199DualType
2200_db_rename(ref)
2201	SV * 		ref
2202	PREINIT:
2203	  dMY_CXT;
2204	CODE:
2205	{
2206#ifndef AT_LEAST_DB_3_1
2207	    softCrash("BerkeleyDB::db_rename needs Berkeley DB 3.1.x or better") ;
2208#else
2209	    HV *		hash ;
2210    	    DB *		dbp ;
2211	    SV * 		sv ;
2212	    const char *	db = NULL ;
2213	    const char *	subdb 	= NULL ;
2214	    const char *	newname	= NULL ;
2215	    BerkeleyDB__Env	env 	= NULL ;
2216	    BerkeleyDB__Txn	txn 	= NULL ;
2217    	    DB_ENV *		dbenv   = NULL ;
2218	    u_int32_t		flags	= 0 ;
2219
2220	    hash = (HV*) SvRV(ref) ;
2221	    SetValue_pv(db,    "Filename", char *) ;
2222	    SetValue_pv(subdb, "Subname", char *) ;
2223	    SetValue_pv(newname, "Newname", char *) ;
2224	    SetValue_iv(flags, "Flags") ;
2225	    SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2226            SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
2227            if (txn) {
2228#ifdef AT_LEAST_DB_4_1
2229                if (!env)
2230                    softCrash("transactional db_rename requires an environment");
2231                RETVAL = env->Status = env->Env->dbrename(env->Env, txn->txn, db, subdb, newname, flags);
2232#else
2233                softCrash("transactional db_rename requires Berkeley DB 4.1 or better");
2234#endif
2235            } else {
2236                if (env)
2237                    dbenv = env->Env ;
2238                RETVAL = db_create(&dbp, dbenv, 0) ;
2239                if (RETVAL == 0) {
2240                    RETVAL = (dbp->rename)(dbp, db, subdb, newname, flags) ;
2241            }
2242        }
2243#endif
2244	}
2245	OUTPUT:
2246	    RETVAL
2247
2248MODULE = BerkeleyDB::Env		PACKAGE = BerkeleyDB::Env PREFIX = env_
2249
2250BerkeleyDB::Env::Raw
2251create(flags=0)
2252	u_int32_t flags
2253	PREINIT:
2254	  dMY_CXT;
2255	CODE:
2256	{
2257#ifndef AT_LEAST_DB_4_1
2258	    softCrash("$env->create needs Berkeley DB 4.1 or better") ;
2259#else
2260	    DB_ENV *	env ;
2261	    int    status;
2262	    RETVAL = NULL;
2263	    Trace(("in BerkeleyDB::Env::create flags=%d\n",  flags)) ;
2264	    status = db_env_create(&env, flags) ;
2265	    Trace(("db_env_create returned %s\n", my_db_strerror(status))) ;
2266	    if (status == 0) {
2267	        ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
2268		RETVAL->Env = env ;
2269	        RETVAL->active = TRUE ;
2270	        RETVAL->opened = FALSE;
2271	        env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
2272	        env->set_errcall(env, db_errcall_cb) ;
2273	    }
2274#endif
2275	}
2276	OUTPUT:
2277	    RETVAL
2278
2279int
2280open(env, db_home=NULL, flags=0, mode=0777)
2281	BerkeleyDB::Env env
2282	char * db_home
2283	u_int32_t flags
2284	int mode
2285	PREINIT:
2286	  dMY_CXT;
2287    CODE:
2288#ifndef AT_LEAST_DB_4_1
2289	    softCrash("$env->create needs Berkeley DB 4.1 or better") ;
2290#else
2291        RETVAL = env->Env->open(env->Env, db_home, flags, mode);
2292	env->opened = TRUE;
2293#endif
2294    OUTPUT:
2295        RETVAL
2296
2297bool
2298cds_enabled(env)
2299	BerkeleyDB::Env env
2300	PREINIT:
2301	  dMY_CXT;
2302	CODE:
2303	    RETVAL = env->cds_enabled ;
2304	OUTPUT:
2305	    RETVAL
2306
2307
2308int
2309set_encrypt(env, passwd, flags)
2310	BerkeleyDB::Env env
2311	const char * passwd
2312	u_int32_t flags
2313	PREINIT:
2314	  dMY_CXT;
2315    CODE:
2316#ifndef AT_LEAST_DB_4_1
2317	    softCrash("$env->set_encrypt needs Berkeley DB 4.1 or better") ;
2318#else
2319        dieIfEnvOpened(env, "set_encrypt");
2320        RETVAL = env->Env->set_encrypt(env->Env, passwd, flags);
2321	env->opened = TRUE;
2322#endif
2323    OUTPUT:
2324        RETVAL
2325
2326
2327
2328
2329BerkeleyDB::Env::Raw
2330_db_appinit(self, ref, errfile=NULL)
2331	char *		self
2332	SV * 		ref
2333	SV * 		errfile
2334	PREINIT:
2335	  dMY_CXT;
2336	CODE:
2337	{
2338	    HV *	hash ;
2339	    SV *	sv ;
2340	    char *	enc_passwd = NULL ;
2341	    int		enc_flags = 0 ;
2342	    char *	home = NULL ;
2343	    char * 	server = NULL ;
2344	    char **	config = NULL ;
2345	    int		flags = 0 ;
2346	    int		setflags = 0 ;
2347	    int		cachesize = 0 ;
2348	    int		lk_detect = 0 ;
2349	    long	shm_key = 0 ;
2350	    char*	data_dir = 0;
2351	    char*	log_dir = 0;
2352	    char*	temp_dir = 0;
2353	    SV *	msgfile = NULL ;
2354        int     thread_count = 0 ;
2355	    SV *	errprefix = NULL;
2356	    DB_ENV *	env ;
2357	    int status ;
2358
2359	    Trace(("in _db_appinit [%s] %d\n", self, ref)) ;
2360	    hash = (HV*) SvRV(ref) ;
2361	    SetValue_pv(home,      "Home", char *) ;
2362	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
2363	    SetValue_iv(enc_flags, "Enc_Flags") ;
2364	    SetValue_pv(config,    "Config", char **) ;
2365	    SetValue_sv(errprefix, "ErrPrefix") ;
2366	    SetValue_iv(flags,     "Flags") ;
2367	    SetValue_iv(setflags,  "SetFlags") ;
2368	    SetValue_pv(server,    "Server", char *) ;
2369	    SetValue_iv(cachesize, "Cachesize") ;
2370	    SetValue_iv(lk_detect, "LockDetect") ;
2371	    SetValue_iv(shm_key,   "SharedMemKey") ;
2372		SetValue_iv(thread_count,   "ThreadCount") ;
2373	    SetValue_pv(data_dir,   "DB_DATA_DIR", char*) ;
2374	    SetValue_pv(temp_dir,   "DB_TEMP_DIR", char*) ;
2375	    SetValue_pv(log_dir,    "DB_LOG_DIR", char*) ;
2376	    SetValue_sv(msgfile,    "MsgFile") ;
2377#ifndef AT_LEAST_DB_3_2
2378	    if (setflags)
2379	        softCrash("-SetFlags needs Berkeley DB 3.x or better") ;
2380#endif /* ! AT_LEAST_DB_3 */
2381#ifndef AT_LEAST_DB_3_1
2382	    if (shm_key)
2383	        softCrash("-SharedMemKey needs Berkeley DB 3.1 or better") ;
2384	    if (server)
2385	        softCrash("-Server needs Berkeley DB 3.1 or better") ;
2386#endif /* ! AT_LEAST_DB_3_1 */
2387#ifndef AT_LEAST_DB_4_1
2388	    if (enc_passwd)
2389	        softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
2390#endif /* ! AT_LEAST_DB_4_1 */
2391#ifndef AT_LEAST_DB_4_3
2392	    if (msgfile)
2393	        softCrash("-MsgFile needs Berkeley DB 4.3.x or better") ;
2394#endif /* ! AT_LEAST_DB_4_3 */
2395#ifdef _WIN32
2396		if (thread_count)
2397			softCrash("-ThreadCount not supported on Windows") ;
2398#endif /* ! _WIN32 */
2399#ifndef AT_LEAST_DB_4_4
2400		if (thread_count)
2401			softCrash("-ThreadCount needs Berkeley DB 4.4 or better") ;
2402#endif /* ! AT_LEAST_DB_4_4 */
2403	    Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n",
2404			config, home, errprefix, flags)) ;
2405#ifdef TRACE
2406	    if (config) {
2407	       int i ;
2408	      for (i = 0 ; i < 10 ; ++ i) {
2409		if (config[i] == NULL) {
2410		    printf("    End\n") ;
2411		    break ;
2412		}
2413	        printf("    config = [%s]\n", config[i]) ;
2414	      }
2415	    }
2416#endif /* TRACE */
2417	    ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
2418	    if (flags & DB_INIT_TXN)
2419	        RETVAL->txn_enabled = TRUE ;
2420#if DB_VERSION_MAJOR == 2
2421	  ZMALLOC(RETVAL->Env, DB_ENV) ;
2422	  env = RETVAL->Env ;
2423	  {
2424	    /* Take a copy of the error prefix */
2425	    if (errprefix) {
2426	        Trace(("copying errprefix\n" )) ;
2427		RETVAL->ErrPrefix = newSVsv(errprefix) ;
2428		SvPOK_only(RETVAL->ErrPrefix) ;
2429	    }
2430	    if (RETVAL->ErrPrefix)
2431	        RETVAL->Env->db_errpfx = SvPVX(RETVAL->ErrPrefix) ;
2432
2433	    if (SvGMAGICAL(errfile))
2434		    mg_get(errfile);
2435	    if (SvOK(errfile)) {
2436	        FILE * ef = GetFILEptr(errfile) ;
2437	    	if (! ef)
2438		    croak("Cannot open file ErrFile", Strerror(errno));
2439		RETVAL->ErrHandle = newSVsv(errfile) ;
2440	    	env->db_errfile = ef;
2441	    }
2442	    SetValue_iv(env->db_verbose, "Verbose") ;
2443	    env->db_errcall = db_errcall_cb ;
2444	    RETVAL->active = TRUE ;
2445	    RETVAL->opened = TRUE;
2446	    RETVAL->cds_enabled = ((flags & DB_INIT_CDB) != 0 ? TRUE : FALSE) ;
2447	    status = db_appinit(home, config, env, flags) ;
2448	    printf("  status = %d errno %d \n", status, errno) ;
2449	    Trace(("  status = %d env %d Env %d\n", status, RETVAL, env)) ;
2450	    if (status == 0)
2451	        hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
2452	    else {
2453
2454                if (RETVAL->ErrHandle)
2455                    SvREFCNT_dec(RETVAL->ErrHandle) ;
2456                if (RETVAL->ErrPrefix)
2457                    SvREFCNT_dec(RETVAL->ErrPrefix) ;
2458                Safefree(RETVAL->Env) ;
2459                Safefree(RETVAL) ;
2460		RETVAL = NULL ;
2461	    }
2462	  }
2463#else /* DB_VERSION_MAJOR > 2 */
2464#ifndef AT_LEAST_DB_3_1
2465#    define DB_CLIENT	0
2466#endif
2467#ifdef AT_LEAST_DB_4_2
2468#    define DB_CLIENT	DB_RPCCLIENT
2469#endif
2470	  status = db_env_create(&RETVAL->Env, server ? DB_CLIENT : 0) ;
2471	  Trace(("db_env_create flags = %d returned %s\n", flags,
2472	  					my_db_strerror(status))) ;
2473	  env = RETVAL->Env ;
2474#ifdef AT_LEAST_DB_3_3
2475	  env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
2476#endif
2477#ifdef AT_LEAST_DB_3_1
2478	  if (status == 0 && shm_key) {
2479	      status = env->set_shm_key(env, shm_key) ;
2480	      Trace(("set_shm_key [%d] returned %s\n", shm_key,
2481			my_db_strerror(status)));
2482	  }
2483
2484	  if (status == 0 && data_dir) {
2485	      status = env->set_data_dir(env, data_dir) ;
2486	      Trace(("set_data_dir [%s] returned %s\n", data_dir,
2487			my_db_strerror(status)));
2488	  }
2489
2490	  if (status == 0 && temp_dir) {
2491	      status = env->set_tmp_dir(env, temp_dir) ;
2492	      Trace(("set_tmp_dir [%s] returned %s\n", temp_dir,
2493			my_db_strerror(status)));
2494	  }
2495
2496	  if (status == 0 && log_dir) {
2497	      status = env->set_lg_dir(env, log_dir) ;
2498	      Trace(("set_lg_dir [%s] returned %s\n", log_dir,
2499			my_db_strerror(status)));
2500	  }
2501#endif
2502	  if (status == 0 && cachesize) {
2503	      status = env->set_cachesize(env, 0, cachesize, 0) ;
2504	      Trace(("set_cachesize [%d] returned %s\n",
2505			cachesize, my_db_strerror(status)));
2506	  }
2507
2508	  if (status == 0 && lk_detect) {
2509	      status = env->set_lk_detect(env, lk_detect) ;
2510	      Trace(("set_lk_detect [%d] returned %s\n",
2511	              lk_detect, my_db_strerror(status)));
2512	  }
2513#ifdef AT_LEAST_DB_4_1
2514	  /* set encryption */
2515	  if (enc_passwd && status == 0)
2516	  {
2517	      status = env->set_encrypt(env, enc_passwd, enc_flags);
2518	      Trace(("ENV->set_encrypt passwd = %s, flags %d returned %s\n",
2519				      		enc_passwd, enc_flags,
2520	  					my_db_strerror(status))) ;
2521	  }
2522#endif
2523#ifdef AT_LEAST_DB_4
2524	  /* set the server */
2525	  if (server && status == 0)
2526	  {
2527	      status = env->set_rpc_server(env, NULL, server, 0, 0, 0);
2528	      Trace(("ENV->set_rpc_server server = %s returned %s\n", server,
2529	  					my_db_strerror(status))) ;
2530	  }
2531#else
2532#  if defined(AT_LEAST_DB_3_1) && ! defined(AT_LEAST_DB_4)
2533	  /* set the server */
2534	  if (server && status == 0)
2535	  {
2536	      status = env->set_server(env, server, 0, 0, 0);
2537	      Trace(("ENV->set_server server = %s returned %s\n", server,
2538	  					my_db_strerror(status))) ;
2539	  }
2540#  endif
2541#endif
2542#ifdef AT_LEAST_DB_3_2
2543	  if (setflags && status == 0)
2544	  {
2545	      status = env->set_flags(env, setflags, 1);
2546	      Trace(("ENV->set_flags value = %d returned %s\n", setflags,
2547	  					my_db_strerror(status))) ;
2548	  }
2549#endif
2550#if defined(AT_LEAST_DB_4_4) && ! defined(_WIN32)
2551	  if (thread_count && status == 0)
2552	  {
2553		  status = env->set_thread_count(env, thread_count);
2554		  Trace(("ENV->set_thread_count value = %d returned %s\n", thread_count,
2555						my_db_strerror(status))) ;
2556	  }
2557#endif
2558
2559	  if (status == 0)
2560	  {
2561	    int		mode = 0 ;
2562	    /* Take a copy of the error prefix */
2563	    if (errprefix) {
2564	        Trace(("copying errprefix\n" )) ;
2565		RETVAL->ErrPrefix = newSVsv(errprefix) ;
2566		SvPOK_only(RETVAL->ErrPrefix) ;
2567	    }
2568	    if (RETVAL->ErrPrefix)
2569	        env->set_errpfx(env, SvPVX(RETVAL->ErrPrefix)) ;
2570
2571	    if (SvGMAGICAL(errfile))
2572		    mg_get(errfile);
2573	    if (SvOK(errfile)) {
2574	        FILE * ef = GetFILEptr(errfile);
2575	    	if (! ef)
2576		    croak("Cannot open file ErrFile", Strerror(errno));
2577		RETVAL->ErrHandle = newSVsv(errfile) ;
2578	    	env->set_errfile(env, ef) ;
2579
2580	    }
2581#ifdef AT_LEAST_DB_4_3
2582	    if (msgfile) {
2583	        if (SvGMAGICAL(msgfile))
2584		    mg_get(msgfile);
2585	        if (SvOK(msgfile)) {
2586	            FILE * ef = GetFILEptr(msgfile);
2587	    	    if (! ef)
2588		        croak("Cannot open file MsgFile", Strerror(errno));
2589		    RETVAL->MsgHandle = newSVsv(msgfile) ;
2590	    	    env->set_msgfile(env, ef) ;
2591	        }
2592	    }
2593#endif
2594	    SetValue_iv(mode, "Mode") ;
2595	    env->set_errcall(env, db_errcall_cb) ;
2596	    RETVAL->active = TRUE ;
2597	    RETVAL->cds_enabled = ((flags & DB_INIT_CDB) != 0 ? TRUE : FALSE) ;
2598#ifdef IS_DB_3_0_x
2599	    status = (env->open)(env, home, config, flags, mode) ;
2600#else /* > 3.0 */
2601	    status = (env->open)(env, home, flags, mode) ;
2602#endif
2603	    Trace(("ENV->open(env=%s,home=%s,flags=%d,mode=%d)\n",env,home,flags,mode)) ;
2604	    Trace(("ENV->open returned %s\n", my_db_strerror(status))) ;
2605	  }
2606
2607	  if (status == 0)
2608	      hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
2609	  else {
2610	      (env->close)(env, 0) ;
2611#ifdef AT_LEAST_DB_4_3
2612              if (RETVAL->MsgHandle)
2613                  SvREFCNT_dec(RETVAL->MsgHandle) ;
2614#endif
2615              if (RETVAL->ErrHandle)
2616                  SvREFCNT_dec(RETVAL->ErrHandle) ;
2617              if (RETVAL->ErrPrefix)
2618                  SvREFCNT_dec(RETVAL->ErrPrefix) ;
2619              Safefree(RETVAL) ;
2620	      RETVAL = NULL ;
2621	  }
2622#endif /* DB_VERSION_MAJOR > 2 */
2623	  {
2624	      SV * sv_err = perl_get_sv(ERR_BUFF, FALSE);
2625	      sv_setpv(sv_err, db_strerror(status));
2626	  }
2627	}
2628	OUTPUT:
2629	    RETVAL
2630
2631DB_ENV*
2632DB_ENV(env)
2633	BerkeleyDB::Env		env
2634	PREINIT:
2635	  dMY_CXT;
2636	CODE:
2637	    if (env->active)
2638	        RETVAL = env->Env ;
2639	    else
2640	        RETVAL = NULL;
2641	OUTPUT:
2642        RETVAL
2643
2644
2645void
2646log_archive(env, flags=0)
2647	u_int32_t		flags
2648	BerkeleyDB::Env		env
2649	PREINIT:
2650	  dMY_CXT;
2651	PPCODE:
2652	{
2653	  char ** list;
2654	  char ** file;
2655	  AV    * av;
2656#ifndef AT_LEAST_DB_3
2657          softCrash("log_archive needs at least Berkeley DB 3.x.x");
2658#else
2659#  ifdef AT_LEAST_DB_4
2660	  env->Status = env->Env->log_archive(env->Env, &list, flags) ;
2661#  else
2662#    ifdef AT_LEAST_DB_3_3
2663	  env->Status = log_archive(env->Env, &list, flags) ;
2664#    else
2665	  env->Status = log_archive(env->Env, &list, flags, safemalloc) ;
2666#    endif
2667#  endif
2668#ifdef DB_ARCH_REMOVE
2669	  if (env->Status == 0 && list != NULL && flags != DB_ARCH_REMOVE)
2670#else
2671	  if (env->Status == 0 && list != NULL )
2672#endif
2673          {
2674	      for (file = list; *file != NULL; ++file)
2675	      {
2676	        XPUSHs(sv_2mortal(newSVpv(*file, 0))) ;
2677	      }
2678	      safefree(list);
2679	  }
2680#endif
2681	}
2682
2683DualType
2684log_set_config(env, flags=0, onoff=0)
2685	BerkeleyDB::Env		env
2686	u_int32_t		flags
2687	int			onoff
2688	PREINIT:
2689	  dMY_CXT;
2690	CODE:
2691	{
2692#ifndef AT_LEAST_DB_4_7
2693          softCrash("log_set_config needs at least Berkeley DB 4.7.x");
2694#else
2695	  RETVAL = env->Status = env->Env->log_set_config(env->Env, flags, onoff) ;
2696#endif
2697	}
2698	OUTPUT:
2699	  RETVAL
2700
2701DualType
2702log_get_config(env, flags, onoff)
2703	BerkeleyDB::Env		env
2704	u_int32_t		flags
2705	int			    onoff=NO_INIT
2706	PREINIT:
2707	  dMY_CXT;
2708	CODE:
2709	{
2710#ifndef AT_LEAST_DB_4_7
2711      softCrash("log_get_config needs at least Berkeley DB 4.7.x");
2712#else
2713	  RETVAL = env->Status = env->Env->log_get_config(env->Env, flags, &onoff) ;
2714#endif
2715	}
2716	OUTPUT:
2717	  RETVAL
2718      onoff
2719
2720
2721BerkeleyDB::Txn::Raw
2722_txn_begin(env, pid=NULL, flags=0)
2723	u_int32_t		flags
2724	BerkeleyDB::Env		env
2725	BerkeleyDB::Txn		pid
2726	PREINIT:
2727	  dMY_CXT;
2728	CODE:
2729	{
2730	    DB_TXN *txn ;
2731	    DB_TXN *p_id = NULL ;
2732	    Trace(("txn_begin pid %d, flags %d\n", pid, flags)) ;
2733#if DB_VERSION_MAJOR == 2
2734	    if (env->Env->tx_info == NULL)
2735		softCrash("Transaction Manager not enabled") ;
2736#endif
2737	    if (!env->txn_enabled)
2738		softCrash("Transaction Manager not enabled") ;
2739	    if (pid)
2740		p_id = pid->txn ;
2741	    env->TxnMgrStatus =
2742#if DB_VERSION_MAJOR == 2
2743	    	txn_begin(env->Env->tx_info, p_id, &txn) ;
2744#else
2745#  ifdef AT_LEAST_DB_4
2746	    	env->Env->txn_begin(env->Env, p_id, &txn, flags) ;
2747#  else
2748	    	txn_begin(env->Env, p_id, &txn, flags) ;
2749#  endif
2750#endif
2751	    if (env->TxnMgrStatus == 0) {
2752	      ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
2753	      RETVAL->txn  = txn ;
2754	      RETVAL->active = TRUE ;
2755	      Trace(("_txn_begin created txn [%p] in [%p]\n", txn, RETVAL));
2756	      hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
2757	    }
2758	    else
2759		RETVAL = NULL ;
2760	}
2761	OUTPUT:
2762	    RETVAL
2763
2764
2765#if DB_VERSION_MAJOR == 2
2766#  define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env->tx_info, k, m)
2767#else /* DB 3.0 or better */
2768#  ifdef AT_LEAST_DB_4
2769#    define env_txn_checkpoint(e,k,m,f) e->Env->txn_checkpoint(e->Env, k, m, f)
2770#  else
2771#    ifdef AT_LEAST_DB_3_1
2772#      define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m, 0)
2773#    else
2774#      define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m)
2775#    endif
2776#  endif
2777#endif
2778DualType
2779env_txn_checkpoint(env, kbyte, min, flags=0)
2780	BerkeleyDB::Env		env
2781	long			kbyte
2782	long			min
2783	u_int32_t		flags
2784	PREINIT:
2785	  dMY_CXT;
2786
2787HV *
2788txn_stat(env)
2789	BerkeleyDB::Env		env
2790	HV *			RETVAL = NULL ;
2791	PREINIT:
2792	  dMY_CXT;
2793	CODE:
2794	{
2795	    DB_TXN_STAT *	stat ;
2796#ifdef AT_LEAST_DB_4
2797	    if(env->Env->txn_stat(env->Env, &stat, 0) == 0) {
2798#else
2799#  ifdef AT_LEAST_DB_3_3
2800	    if(txn_stat(env->Env, &stat) == 0) {
2801#  else
2802#    if DB_VERSION_MAJOR == 2
2803	    if(txn_stat(env->Env->tx_info, &stat, safemalloc) == 0) {
2804#    else
2805	    if(txn_stat(env->Env, &stat, safemalloc) == 0) {
2806#    endif
2807#  endif
2808#endif
2809	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
2810		hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
2811		hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
2812		hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
2813		hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
2814		hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
2815		hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
2816		hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
2817#if DB_VERSION_MAJOR > 2
2818		hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
2819		hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
2820		hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
2821		hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
2822#endif
2823		safefree(stat) ;
2824	    }
2825	}
2826	OUTPUT:
2827	    RETVAL
2828
2829#define EnDis(x)	((x) ? "Enabled" : "Disabled")
2830void
2831printEnv(env)
2832        BerkeleyDB::Env  env
2833	PREINIT:
2834	  dMY_CXT;
2835	INIT:
2836	    ckActive_Environment(env->active) ;
2837	CODE:
2838#if 0
2839	  printf("env             [0x%X]\n", env) ;
2840	  printf("  ErrPrefix     [%s]\n", env->ErrPrefix
2841				           ? SvPVX(env->ErrPrefix) : 0) ;
2842	  printf("  DB_ENV\n") ;
2843	  printf("    db_lorder   [%d]\n", env->Env.db_lorder) ;
2844	  printf("    db_home     [%s]\n", env->Env.db_home) ;
2845	  printf("    db_data_dir [%s]\n", env->Env.db_data_dir) ;
2846	  printf("    db_log_dir  [%s]\n", env->Env.db_log_dir) ;
2847	  printf("    db_tmp_dir  [%s]\n", env->Env.db_tmp_dir) ;
2848	  printf("    lk_info     [%s]\n", EnDis(env->Env.lk_info)) ;
2849	  printf("    lk_max      [%d]\n", env->Env.lk_max) ;
2850	  printf("    lg_info     [%s]\n", EnDis(env->Env.lg_info)) ;
2851	  printf("    lg_max      [%d]\n", env->Env.lg_max) ;
2852	  printf("    mp_info     [%s]\n", EnDis(env->Env.mp_info)) ;
2853	  printf("    mp_size     [%d]\n", env->Env.mp_size) ;
2854	  printf("    tx_info     [%s]\n", EnDis(env->Env.tx_info)) ;
2855	  printf("    tx_max      [%d]\n", env->Env.tx_max) ;
2856	  printf("    flags       [%d]\n", env->Env.flags) ;
2857	  printf("\n") ;
2858#endif
2859
2860SV *
2861errPrefix(env, prefix)
2862        BerkeleyDB::Env  env
2863	SV * 		 prefix
2864	PREINIT:
2865	  dMY_CXT;
2866	INIT:
2867	    ckActive_Environment(env->active) ;
2868	CODE:
2869	  if (env->ErrPrefix) {
2870	      RETVAL = newSVsv(env->ErrPrefix) ;
2871              SvPOK_only(RETVAL) ;
2872	      sv_setsv(env->ErrPrefix, prefix) ;
2873	  }
2874	  else {
2875	      RETVAL = NULL ;
2876	      env->ErrPrefix = newSVsv(prefix) ;
2877	  }
2878	  SvPOK_only(env->ErrPrefix) ;
2879#if DB_VERSION_MAJOR == 2
2880	  env->Env->db_errpfx = SvPVX(env->ErrPrefix) ;
2881#else
2882	  env->Env->set_errpfx(env->Env, SvPVX(env->ErrPrefix)) ;
2883#endif
2884	OUTPUT:
2885	  RETVAL
2886
2887DualType
2888status(env)
2889        BerkeleyDB::Env 	env
2890	PREINIT:
2891	  dMY_CXT;
2892	CODE:
2893	    RETVAL =  env->Status ;
2894	OUTPUT:
2895	    RETVAL
2896
2897
2898
2899DualType
2900db_appexit(env)
2901        BerkeleyDB::Env 	env
2902	PREINIT:
2903	  dMY_CXT;
2904	ALIAS:	close =1
2905	INIT:
2906	    ckActive_Environment(env->active) ;
2907	CODE:
2908#ifdef STRICT_CLOSE
2909	    if (env->open_dbs)
2910		softCrash("attempted to close an environment with %d open database(s)",
2911			env->open_dbs) ;
2912#endif /* STRICT_CLOSE */
2913#if DB_VERSION_MAJOR == 2
2914	    RETVAL = db_appexit(env->Env) ;
2915#else
2916	    RETVAL = (env->Env->close)(env->Env, 0) ;
2917#endif
2918	    env->active = FALSE ;
2919	    hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
2920	OUTPUT:
2921	    RETVAL
2922
2923
2924void
2925_DESTROY(env)
2926        BerkeleyDB::Env  env
2927	int RETVAL = 0 ;
2928	PREINIT:
2929	  dMY_CXT;
2930	CODE:
2931	  Trace(("In BerkeleyDB::Env::DESTROY\n"));
2932	  Trace(("    env %ld Env %ld dirty %d\n", env, &env->Env, PL_dirty)) ;
2933	  if (env->active)
2934#if DB_VERSION_MAJOR == 2
2935              db_appexit(env->Env) ;
2936#else
2937	      (env->Env->close)(env->Env, 0) ;
2938#endif
2939          if (env->ErrHandle)
2940              SvREFCNT_dec(env->ErrHandle) ;
2941#ifdef AT_LEAST_DB_4_3
2942          if (env->MsgHandle)
2943              SvREFCNT_dec(env->MsgHandle) ;
2944#endif
2945          if (env->ErrPrefix)
2946              SvREFCNT_dec(env->ErrPrefix) ;
2947#if DB_VERSION_MAJOR == 2
2948          Safefree(env->Env) ;
2949#endif
2950          Safefree(env) ;
2951	  hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
2952	  Trace(("End of BerkeleyDB::Env::DESTROY %d\n", RETVAL)) ;
2953
2954BerkeleyDB::TxnMgr::Raw
2955_TxnMgr(env)
2956        BerkeleyDB::Env  env
2957	PREINIT:
2958	  dMY_CXT;
2959	INIT:
2960	    ckActive_Environment(env->active) ;
2961	    if (!env->txn_enabled)
2962		softCrash("Transaction Manager not enabled") ;
2963	CODE:
2964	    ZMALLOC(RETVAL, BerkeleyDB_TxnMgr_type) ;
2965	    RETVAL->env  = env ;
2966	    /* hash_store_iv("BerkeleyDB::Term::TxnMgr", (char *)txn, 1) ; */
2967	OUTPUT:
2968	    RETVAL
2969
2970int
2971get_shm_key(env, id)
2972        BerkeleyDB::Env  env
2973	long  		 id = NO_INIT
2974	PREINIT:
2975	  dMY_CXT;
2976	INIT:
2977	  ckActive_Database(env->active) ;
2978	CODE:
2979#ifndef AT_LEAST_DB_4_2
2980	    softCrash("$env->get_shm_key needs Berkeley DB 4.2 or better") ;
2981#else
2982	    RETVAL = env->Env->get_shm_key(env->Env, &id);
2983#endif
2984	OUTPUT:
2985	    RETVAL
2986	    id
2987
2988
2989int
2990set_lg_dir(env, dir)
2991        BerkeleyDB::Env  env
2992	char *		 dir
2993	PREINIT:
2994	  dMY_CXT;
2995	INIT:
2996	  ckActive_Database(env->active) ;
2997	CODE:
2998#ifndef AT_LEAST_DB_3_1
2999	    softCrash("$env->set_lg_dir needs Berkeley DB 3.1 or better") ;
3000#else
3001	    RETVAL = env->Status = env->Env->set_lg_dir(env->Env, dir);
3002#endif
3003	OUTPUT:
3004	    RETVAL
3005
3006int
3007set_lg_bsize(env, bsize)
3008        BerkeleyDB::Env  env
3009	u_int32_t	 bsize
3010	PREINIT:
3011	  dMY_CXT;
3012	INIT:
3013	  ckActive_Database(env->active) ;
3014	CODE:
3015#ifndef AT_LEAST_DB_3
3016	    softCrash("$env->set_lg_bsize needs Berkeley DB 3.0.55 or better") ;
3017#else
3018	    RETVAL = env->Status = env->Env->set_lg_bsize(env->Env, bsize);
3019#endif
3020	OUTPUT:
3021	    RETVAL
3022
3023int
3024set_lg_max(env, lg_max)
3025        BerkeleyDB::Env  env
3026	u_int32_t	 lg_max
3027	PREINIT:
3028	  dMY_CXT;
3029	INIT:
3030	  ckActive_Database(env->active) ;
3031	CODE:
3032#ifndef AT_LEAST_DB_3
3033	    softCrash("$env->set_lg_max needs Berkeley DB 3.0.55 or better") ;
3034#else
3035	    RETVAL = env->Status = env->Env->set_lg_max(env->Env, lg_max);
3036#endif
3037	OUTPUT:
3038	    RETVAL
3039
3040int
3041set_data_dir(env, dir)
3042        BerkeleyDB::Env  env
3043	char *		 dir
3044	PREINIT:
3045	  dMY_CXT;
3046	INIT:
3047	  ckActive_Database(env->active) ;
3048	CODE:
3049#ifndef AT_LEAST_DB_3_1
3050	    softCrash("$env->set_data_dir needs Berkeley DB 3.1 or better") ;
3051#else
3052            dieIfEnvOpened(env, "set_data_dir");
3053	    RETVAL = env->Status = env->Env->set_data_dir(env->Env, dir);
3054#endif
3055	OUTPUT:
3056	    RETVAL
3057
3058int
3059set_tmp_dir(env, dir)
3060        BerkeleyDB::Env  env
3061	char *		 dir
3062	PREINIT:
3063	  dMY_CXT;
3064	INIT:
3065	  ckActive_Database(env->active) ;
3066	CODE:
3067#ifndef AT_LEAST_DB_3_1
3068	    softCrash("$env->set_tmp_dir needs Berkeley DB 3.1 or better") ;
3069#else
3070	    RETVAL = env->Status = env->Env->set_tmp_dir(env->Env, dir);
3071#endif
3072	OUTPUT:
3073	    RETVAL
3074
3075int
3076set_mutexlocks(env, do_lock)
3077        BerkeleyDB::Env  env
3078	int 		 do_lock
3079	PREINIT:
3080	  dMY_CXT;
3081	INIT:
3082	  ckActive_Database(env->active) ;
3083	CODE:
3084#ifndef AT_LEAST_DB_3
3085	    softCrash("$env->set_setmutexlocks needs Berkeley DB 3.0 or better") ;
3086#else
3087#  ifdef AT_LEAST_DB_4
3088	    RETVAL = env->Status = env->Env->set_flags(env->Env, DB_NOLOCKING, !do_lock);
3089#  else
3090#    if defined(AT_LEAST_DB_3_2_6) || defined(IS_DB_3_0_x)
3091	    RETVAL = env->Status = env->Env->set_mutexlocks(env->Env, do_lock);
3092#    else /* DB 3.1 or 3.2.3 */
3093	    RETVAL = env->Status = db_env_set_mutexlocks(do_lock);
3094#    endif
3095#  endif
3096#endif
3097	OUTPUT:
3098	    RETVAL
3099
3100int
3101set_verbose(env, which, onoff)
3102        BerkeleyDB::Env  env
3103	u_int32_t	 which
3104	int	 	 onoff
3105	PREINIT:
3106	  dMY_CXT;
3107	INIT:
3108	  ckActive_Database(env->active) ;
3109	CODE:
3110#ifndef AT_LEAST_DB_3
3111	    softCrash("$env->set_verbose needs Berkeley DB 3.x or better") ;
3112#else
3113	    RETVAL = env->Status = env->Env->set_verbose(env->Env, which, onoff);
3114#endif
3115	OUTPUT:
3116	    RETVAL
3117
3118int
3119set_flags(env, flags, onoff)
3120        BerkeleyDB::Env  env
3121	u_int32_t	 flags
3122	int	 	 onoff
3123	PREINIT:
3124	  dMY_CXT;
3125	INIT:
3126	  ckActive_Database(env->active) ;
3127	CODE:
3128#ifndef AT_LEAST_DB_3_2
3129	    softCrash("$env->set_flags needs Berkeley DB 3.2.x or better") ;
3130#else
3131	    RETVAL = env->Status = env->Env->set_flags(env->Env, flags, onoff);
3132#endif
3133	OUTPUT:
3134	    RETVAL
3135
3136int
3137lsn_reset(env, file, flags)
3138        BerkeleyDB::Env  env
3139	char*       file
3140	u_int32_t	 flags
3141	PREINIT:
3142	  dMY_CXT;
3143	INIT:
3144	  ckActive_Database(env->active) ;
3145	CODE:
3146#ifndef AT_LEAST_DB_4_3
3147	    softCrash("$env->lsn_reset needs Berkeley DB 4.3.x or better") ;
3148#else
3149	    RETVAL = env->Status = env->Env->lsn_reset(env->Env, file, flags);
3150#endif
3151	OUTPUT:
3152	    RETVAL
3153
3154int
3155set_timeout(env, timeout, flags=0)
3156        BerkeleyDB::Env  env
3157	db_timeout_t	 timeout
3158	u_int32_t	 flags
3159	PREINIT:
3160	  dMY_CXT;
3161	INIT:
3162	  ckActive_Database(env->active) ;
3163	CODE:
3164#ifndef AT_LEAST_DB_4
3165	    softCrash("$env->set_timeout needs Berkeley DB 4.x or better") ;
3166#else
3167	    RETVAL = env->Status = env->Env->set_timeout(env->Env, timeout, flags);
3168#endif
3169	OUTPUT:
3170	    RETVAL
3171
3172int
3173get_timeout(env, timeout, flags=0)
3174        BerkeleyDB::Env  env
3175	db_timeout_t	 timeout = NO_INIT
3176	u_int32_t	 flags
3177	PREINIT:
3178	  dMY_CXT;
3179	INIT:
3180	  ckActive_Database(env->active) ;
3181	CODE:
3182#ifndef AT_LEAST_DB_4_2
3183	    softCrash("$env->set_timeout needs Berkeley DB 4.2.x or better") ;
3184#else
3185	    RETVAL = env->Status = env->Env->get_timeout(env->Env, &timeout, flags);
3186#endif
3187	OUTPUT:
3188	    RETVAL
3189	    timeout
3190
3191int
3192stat_print(env, flags=0)
3193	BerkeleyDB::Env  env
3194	u_int32_t    flags
3195	INIT:
3196	  ckActive_Database(env->active) ;
3197	CODE:
3198#ifndef AT_LEAST_DB_4_3
3199		softCrash("$env->stat_print needs Berkeley DB 4.3 or better") ;
3200#else
3201		RETVAL = env->Status = env->Env->stat_print(env->Env, flags);
3202#endif
3203	OUTPUT:
3204		RETVAL
3205
3206int
3207lock_stat_print(env, flags=0)
3208	BerkeleyDB::Env  env
3209	u_int32_t    flags
3210	INIT:
3211	  ckActive_Database(env->active) ;
3212	CODE:
3213#ifndef AT_LEAST_DB_4_3
3214		softCrash("$env->lock_stat_print needs Berkeley DB 4.3 or better") ;
3215#else
3216		RETVAL = env->Status = env->Env->lock_stat_print(env->Env, flags);
3217#endif
3218	OUTPUT:
3219		RETVAL
3220
3221int
3222mutex_stat_print(env, flags=0)
3223	BerkeleyDB::Env  env
3224	u_int32_t    flags
3225	INIT:
3226	  ckActive_Database(env->active) ;
3227	CODE:
3228#ifndef AT_LEAST_DB_4_4
3229		softCrash("$env->mutex_stat_print needs Berkeley DB 4.4 or better") ;
3230#else
3231		RETVAL = env->Status = env->Env->mutex_stat_print(env->Env, flags);
3232#endif
3233	OUTPUT:
3234		RETVAL
3235
3236
3237int
3238txn_stat_print(env, flags=0)
3239	BerkeleyDB::Env  env
3240	u_int32_t    flags
3241	INIT:
3242	  ckActive_Database(env->active) ;
3243	CODE:
3244#ifndef AT_LEAST_DB_4_3
3245		softCrash("$env->mutex_stat_print needs Berkeley DB 4.3 or better") ;
3246#else
3247		RETVAL = env->Status = env->Env->txn_stat_print(env->Env, flags);
3248#endif
3249	OUTPUT:
3250		RETVAL
3251
3252int
3253failchk(env, flags=0)
3254	BerkeleyDB::Env  env
3255	u_int32_t    flags
3256	INIT:
3257	  ckActive_Database(env->active) ;
3258	CODE:
3259#if ! defined(AT_LEAST_DB_4_4) || defined(_WIN32)
3260#ifndef AT_LEAST_DB_4_4
3261		softCrash("$env->failchk needs Berkeley DB 4.4 or better") ;
3262#endif
3263#ifdef _WIN32
3264		softCrash("$env->failchk not supported on Windows") ;
3265#endif
3266#else
3267		RETVAL = env->Status = env->Env->failchk(env->Env, flags);
3268#endif
3269	OUTPUT:
3270		RETVAL
3271
3272int
3273set_isalive(env)
3274	BerkeleyDB::Env  env
3275	INIT:
3276	  ckActive_Database(env->active) ;
3277	CODE:
3278#if ! defined(AT_LEAST_DB_4_4) || defined(_WIN32)
3279#ifndef AT_LEAST_DB_4_4
3280		softCrash("$env->set_isalive needs Berkeley DB 4.4 or better") ;
3281#endif
3282#ifdef _WIN32
3283		softCrash("$env->set_isalive not supported on Windows") ;
3284#endif
3285#else
3286		RETVAL = env->Status = env->Env->set_isalive(env->Env, db_isalive_cb);
3287#endif
3288	OUTPUT:
3289		RETVAL
3290
3291
3292
3293
3294MODULE = BerkeleyDB::Term		PACKAGE = BerkeleyDB::Term
3295
3296void
3297close_everything()
3298	PREINIT:
3299	  dMY_CXT;
3300
3301#define safeCroak(string)	softCrash(string)
3302void
3303safeCroak(string)
3304	char * string
3305	PREINIT:
3306	  dMY_CXT;
3307
3308MODULE = BerkeleyDB::Hash	PACKAGE = BerkeleyDB::Hash	PREFIX = hash_
3309
3310BerkeleyDB::Hash::Raw
3311_db_open_hash(self, ref)
3312	char *		self
3313	SV * 		ref
3314	PREINIT:
3315	  dMY_CXT;
3316	CODE:
3317	{
3318	    HV *		hash ;
3319	    SV * 		sv ;
3320	    DB_INFO 		info ;
3321	    BerkeleyDB__Env	dbenv = NULL;
3322	    SV *		ref_dbenv = NULL;
3323	    const char *	file = NULL ;
3324	    const char *	subname = NULL ;
3325	    int			flags = 0 ;
3326	    int			mode = 0 ;
3327    	    BerkeleyDB 		db ;
3328    	    BerkeleyDB__Txn 	txn = NULL ;
3329	    char *	enc_passwd = NULL ;
3330	    int		enc_flags = 0 ;
3331
3332    	    Trace(("_db_open_hash start\n")) ;
3333	    hash = (HV*) SvRV(ref) ;
3334	    SetValue_pv(file, "Filename", char *) ;
3335	    SetValue_pv(subname, "Subname", char *) ;
3336	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3337	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3338	    ref_dbenv = sv ;
3339	    SetValue_iv(flags, "Flags") ;
3340	    SetValue_iv(mode, "Mode") ;
3341	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3342	    SetValue_iv(enc_flags, "Enc_Flags") ;
3343
3344       	    Zero(&info, 1, DB_INFO) ;
3345	    SetValue_iv(info.db_cachesize, "Cachesize") ;
3346	    SetValue_iv(info.db_lorder, "Lorder") ;
3347	    SetValue_iv(info.db_pagesize, "Pagesize") ;
3348	    SetValue_iv(info.h_ffactor, "Ffactor") ;
3349	    SetValue_iv(info.h_nelem, "Nelem") ;
3350	    SetValue_iv(info.flags, "Property") ;
3351	    ZMALLOC(db, BerkeleyDB_type) ;
3352	    if ((sv = readHash(hash, "Hash")) && sv != &PL_sv_undef) {
3353		info.h_hash = hash_cb ;
3354		db->hash = newSVsv(sv) ;
3355	    }
3356	    /* DB_DUPSORT was introduced in DB 2.5.9 */
3357	    if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
3358#ifdef DB_DUPSORT
3359		info.dup_compare = dup_compare ;
3360		db->dup_compare = newSVsv(sv) ;
3361		info.flags |= DB_DUP|DB_DUPSORT ;
3362#else
3363	        croak("DupCompare needs Berkeley DB 2.5.9 or later") ;
3364#endif
3365	    }
3366	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3367                    DB_HASH, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3368    	    Trace(("_db_open_hash end\n")) ;
3369	}
3370	OUTPUT:
3371	    RETVAL
3372
3373
3374HV *
3375db_stat(db, flags=0)
3376	int			flags
3377	BerkeleyDB::Common	db
3378	HV *			RETVAL = NULL ;
3379	PREINIT:
3380	  dMY_CXT;
3381	INIT:
3382	  ckActive_Database(db->active) ;
3383	CODE:
3384	{
3385#if DB_VERSION_MAJOR == 2
3386	    softCrash("$db->db_stat for a Hash needs Berkeley DB 3.x or better") ;
3387#else
3388	    DB_HASH_STAT *	stat ;
3389#ifdef AT_LEAST_DB_4_3
3390	    db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3391#else
3392#ifdef AT_LEAST_DB_3_3
3393	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3394#else
3395	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3396#endif
3397#endif
3398	    if (db->Status) {
3399	        XSRETURN_UNDEF;
3400	    } else {
3401	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
3402		hv_store_iv(RETVAL, "hash_magic", stat->hash_magic) ;
3403		hv_store_iv(RETVAL, "hash_version", stat->hash_version);
3404		hv_store_iv(RETVAL, "hash_pagesize", stat->hash_pagesize);
3405#ifdef AT_LEAST_DB_3_1
3406		hv_store_iv(RETVAL, "hash_nkeys", stat->hash_nkeys);
3407		hv_store_iv(RETVAL, "hash_ndata", stat->hash_ndata);
3408#else
3409		hv_store_iv(RETVAL, "hash_nrecs", stat->hash_nrecs);
3410#endif
3411#ifndef AT_LEAST_DB_3_1
3412		hv_store_iv(RETVAL, "hash_nelem", stat->hash_nelem);
3413#endif
3414		hv_store_iv(RETVAL, "hash_ffactor", stat->hash_ffactor);
3415		hv_store_iv(RETVAL, "hash_buckets", stat->hash_buckets);
3416		hv_store_iv(RETVAL, "hash_free", stat->hash_free);
3417		hv_store_iv(RETVAL, "hash_bfree", stat->hash_bfree);
3418		hv_store_iv(RETVAL, "hash_bigpages", stat->hash_bigpages);
3419		hv_store_iv(RETVAL, "hash_big_bfree", stat->hash_big_bfree);
3420		hv_store_iv(RETVAL, "hash_overflows", stat->hash_overflows);
3421		hv_store_iv(RETVAL, "hash_ovfl_free", stat->hash_ovfl_free);
3422		hv_store_iv(RETVAL, "hash_dup", stat->hash_dup);
3423		hv_store_iv(RETVAL, "hash_dup_free", stat->hash_dup_free);
3424#if DB_VERSION_MAJOR >= 3
3425		hv_store_iv(RETVAL, "hash_metaflags", stat->hash_metaflags);
3426#endif
3427		safefree(stat) ;
3428	    }
3429#endif
3430	}
3431	OUTPUT:
3432	    RETVAL
3433
3434
3435MODULE = BerkeleyDB::Unknown	PACKAGE = BerkeleyDB::Unknown	PREFIX = hash_
3436
3437void
3438_db_open_unknown(ref)
3439	SV * 		ref
3440	PREINIT:
3441	  dMY_CXT;
3442	PPCODE:
3443	{
3444	    HV *		hash ;
3445	    SV * 		sv ;
3446	    DB_INFO 		info ;
3447	    BerkeleyDB__Env	dbenv = NULL;
3448	    SV *		ref_dbenv = NULL;
3449	    const char *	file = NULL ;
3450	    const char *	subname = NULL ;
3451	    int			flags = 0 ;
3452	    int			mode = 0 ;
3453    	    BerkeleyDB 		db ;
3454	    BerkeleyDB		RETVAL ;
3455    	    BerkeleyDB__Txn 	txn = NULL ;
3456	    static char * 		Names[] = {"", "Btree", "Hash", "Recno"} ;
3457	    char *	enc_passwd = NULL ;
3458	    int		enc_flags = 0 ;
3459
3460	    hash = (HV*) SvRV(ref) ;
3461	    SetValue_pv(file, "Filename", char *) ;
3462	    SetValue_pv(subname, "Subname", char *) ;
3463	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3464	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3465	    ref_dbenv = sv ;
3466	    SetValue_iv(flags, "Flags") ;
3467	    SetValue_iv(mode, "Mode") ;
3468	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3469	    SetValue_iv(enc_flags, "Enc_Flags") ;
3470
3471       	    Zero(&info, 1, DB_INFO) ;
3472	    SetValue_iv(info.db_cachesize, "Cachesize") ;
3473	    SetValue_iv(info.db_lorder, "Lorder") ;
3474	    SetValue_iv(info.db_pagesize, "Pagesize") ;
3475	    SetValue_iv(info.h_ffactor, "Ffactor") ;
3476	    SetValue_iv(info.h_nelem, "Nelem") ;
3477	    SetValue_iv(info.flags, "Property") ;
3478	    ZMALLOC(db, BerkeleyDB_type) ;
3479
3480	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3481                    DB_UNKNOWN, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3482	    XPUSHs(sv_2mortal(newSViv(PTR2IV(RETVAL))));
3483	    if (RETVAL)
3484	        XPUSHs(sv_2mortal(newSVpv(Names[RETVAL->type], 0))) ;
3485	    else
3486	        XPUSHs(sv_2mortal(newSViv((IV)NULL)));
3487	}
3488
3489
3490
3491MODULE = BerkeleyDB::Btree	PACKAGE = BerkeleyDB::Btree	PREFIX = btree_
3492
3493BerkeleyDB::Btree::Raw
3494_db_open_btree(self, ref)
3495	char *		self
3496	SV * 		ref
3497	PREINIT:
3498	  dMY_CXT;
3499	CODE:
3500	{
3501	    HV *		hash ;
3502	    SV * 		sv ;
3503	    DB_INFO 		info ;
3504	    BerkeleyDB__Env	dbenv = NULL;
3505	    SV *		ref_dbenv = NULL;
3506	    const char *	file = NULL ;
3507	    const char *	subname = NULL ;
3508	    int			flags = 0 ;
3509	    int			mode = 0 ;
3510    	    BerkeleyDB  	db ;
3511    	    BerkeleyDB__Txn 	txn = NULL ;
3512	    char *	enc_passwd = NULL ;
3513	    int		enc_flags = 0 ;
3514
3515	    Trace(("In _db_open_btree\n"));
3516	    hash = (HV*) SvRV(ref) ;
3517	    SetValue_pv(file, "Filename", char*) ;
3518	    SetValue_pv(subname, "Subname", char *) ;
3519	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3520	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3521	    ref_dbenv = sv ;
3522	    SetValue_iv(flags, "Flags") ;
3523	    SetValue_iv(mode, "Mode") ;
3524	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3525	    SetValue_iv(enc_flags, "Enc_Flags") ;
3526
3527       	    Zero(&info, 1, DB_INFO) ;
3528	    SetValue_iv(info.db_cachesize, "Cachesize") ;
3529	    SetValue_iv(info.db_lorder, "Lorder") ;
3530	    SetValue_iv(info.db_pagesize, "Pagesize") ;
3531	    SetValue_iv(info.bt_minkey, "Minkey") ;
3532	    SetValue_iv(info.flags, "Property") ;
3533	    ZMALLOC(db, BerkeleyDB_type) ;
3534	    if ((sv = readHash(hash, "Compare")) && sv != &PL_sv_undef) {
3535		Trace(("    Parsed Compare callback\n"));
3536		info.bt_compare = btree_compare ;
3537		db->compare = newSVsv(sv) ;
3538	    }
3539	    /* DB_DUPSORT was introduced in DB 2.5.9 */
3540	    if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
3541#ifdef DB_DUPSORT
3542		Trace(("    Parsed DupCompare callback\n"));
3543		info.dup_compare = dup_compare ;
3544		db->dup_compare = newSVsv(sv) ;
3545		info.flags |= DB_DUP|DB_DUPSORT ;
3546#else
3547	        softCrash("DupCompare needs Berkeley DB 2.5.9 or later") ;
3548#endif
3549	    }
3550	    if ((sv = readHash(hash, "Prefix")) && sv != &PL_sv_undef) {
3551		Trace(("    Parsed Prefix callback\n"));
3552		info.bt_prefix = btree_prefix ;
3553		db->prefix = newSVsv(sv) ;
3554	    }
3555
3556	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3557                DB_BTREE, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3558	}
3559	OUTPUT:
3560	    RETVAL
3561
3562
3563HV *
3564db_stat(db, flags=0)
3565	int			flags
3566	BerkeleyDB::Common	db
3567	HV *			RETVAL = NULL ;
3568	PREINIT:
3569	  dMY_CXT;
3570	INIT:
3571	  ckActive_Database(db->active) ;
3572	CODE:
3573	{
3574	    DB_BTREE_STAT *	stat ;
3575#ifdef AT_LEAST_DB_4_3
3576	    db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3577#else
3578#ifdef AT_LEAST_DB_3_3
3579	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3580#else
3581	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3582#endif
3583#endif
3584	    if (db->Status) {
3585	        XSRETURN_UNDEF;
3586	    } else {
3587	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
3588		hv_store_iv(RETVAL, "bt_magic", stat->bt_magic);
3589		hv_store_iv(RETVAL, "bt_version", stat->bt_version);
3590#if DB_VERSION_MAJOR > 2
3591		hv_store_iv(RETVAL, "bt_metaflags", stat->bt_metaflags) ;
3592		hv_store_iv(RETVAL, "bt_flags", stat->bt_metaflags) ;
3593#else
3594		hv_store_iv(RETVAL, "bt_flags", stat->bt_flags) ;
3595#endif
3596#ifndef AT_LEAST_DB_4_4
3597		hv_store_iv(RETVAL, "bt_maxkey", stat->bt_maxkey) ;
3598#endif
3599		hv_store_iv(RETVAL, "bt_minkey", stat->bt_minkey);
3600		hv_store_iv(RETVAL, "bt_re_len", stat->bt_re_len);
3601		hv_store_iv(RETVAL, "bt_re_pad", stat->bt_re_pad);
3602		hv_store_iv(RETVAL, "bt_pagesize", stat->bt_pagesize);
3603		hv_store_iv(RETVAL, "bt_levels", stat->bt_levels);
3604#ifdef AT_LEAST_DB_3_1
3605		hv_store_iv(RETVAL, "bt_nkeys", stat->bt_nkeys);
3606		hv_store_iv(RETVAL, "bt_ndata", stat->bt_ndata);
3607#else
3608		hv_store_iv(RETVAL, "bt_nrecs", stat->bt_nrecs);
3609#endif
3610		hv_store_iv(RETVAL, "bt_int_pg", stat->bt_int_pg);
3611		hv_store_iv(RETVAL, "bt_leaf_pg", stat->bt_leaf_pg);
3612		hv_store_iv(RETVAL, "bt_dup_pg", stat->bt_dup_pg);
3613		hv_store_iv(RETVAL, "bt_over_pg", stat->bt_over_pg);
3614		hv_store_iv(RETVAL, "bt_free", stat->bt_free);
3615#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
3616		hv_store_iv(RETVAL, "bt_freed", stat->bt_freed);
3617		hv_store_iv(RETVAL, "bt_pfxsaved", stat->bt_pfxsaved);
3618		hv_store_iv(RETVAL, "bt_split", stat->bt_split);
3619		hv_store_iv(RETVAL, "bt_rootsplit", stat->bt_rootsplit);
3620		hv_store_iv(RETVAL, "bt_fastsplit", stat->bt_fastsplit);
3621		hv_store_iv(RETVAL, "bt_added", stat->bt_added);
3622		hv_store_iv(RETVAL, "bt_deleted", stat->bt_deleted);
3623		hv_store_iv(RETVAL, "bt_get", stat->bt_get);
3624		hv_store_iv(RETVAL, "bt_cache_hit", stat->bt_cache_hit);
3625		hv_store_iv(RETVAL, "bt_cache_miss", stat->bt_cache_miss);
3626#endif
3627		hv_store_iv(RETVAL, "bt_int_pgfree", stat->bt_int_pgfree);
3628		hv_store_iv(RETVAL, "bt_leaf_pgfree", stat->bt_leaf_pgfree);
3629		hv_store_iv(RETVAL, "bt_dup_pgfree", stat->bt_dup_pgfree);
3630		hv_store_iv(RETVAL, "bt_over_pgfree", stat->bt_over_pgfree);
3631		safefree(stat) ;
3632	    }
3633	}
3634	OUTPUT:
3635	    RETVAL
3636
3637
3638MODULE = BerkeleyDB::Recno	PACKAGE = BerkeleyDB::Recno	PREFIX = recno_
3639
3640BerkeleyDB::Recno::Raw
3641_db_open_recno(self, ref)
3642	char *		self
3643	SV * 		ref
3644	PREINIT:
3645	  dMY_CXT;
3646	CODE:
3647	{
3648	    HV *		hash ;
3649	    SV * 		sv ;
3650	    DB_INFO 		info ;
3651	    BerkeleyDB__Env	dbenv = NULL;
3652	    SV *		ref_dbenv = NULL;
3653	    const char *	file = NULL ;
3654	    const char *	subname = NULL ;
3655	    int			flags = 0 ;
3656	    int			mode = 0 ;
3657    	    BerkeleyDB 		db ;
3658    	    BerkeleyDB__Txn 	txn = NULL ;
3659	    char *	enc_passwd = NULL ;
3660	    int		enc_flags = 0 ;
3661
3662	    hash = (HV*) SvRV(ref) ;
3663	    SetValue_pv(file, "Fname", char*) ;
3664	    SetValue_pv(subname, "Subname", char *) ;
3665	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3666	    ref_dbenv = sv ;
3667	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3668	    SetValue_iv(flags, "Flags") ;
3669	    SetValue_iv(mode, "Mode") ;
3670	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3671	    SetValue_iv(enc_flags, "Enc_Flags") ;
3672
3673       	    Zero(&info, 1, DB_INFO) ;
3674	    SetValue_iv(info.db_cachesize, "Cachesize") ;
3675	    SetValue_iv(info.db_lorder, "Lorder") ;
3676	    SetValue_iv(info.db_pagesize, "Pagesize") ;
3677	    SetValue_iv(info.bt_minkey, "Minkey") ;
3678
3679	    SetValue_iv(info.flags, "Property") ;
3680	    SetValue_pv(info.re_source, "Source", char*) ;
3681	    if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
3682		info.re_len = SvIV(sv) ; ;
3683		flagSet_DB2(info.flags, DB_FIXEDLEN) ;
3684	    }
3685	    if ((sv = readHash(hash, "Delim")) && sv != &PL_sv_undef) {
3686		info.re_delim = SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3687		flagSet_DB2(info.flags, DB_DELIMITER) ;
3688	    }
3689	    if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
3690		info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3691		flagSet_DB2(info.flags, DB_PAD) ;
3692	    }
3693	    ZMALLOC(db, BerkeleyDB_type) ;
3694#ifdef ALLOW_RECNO_OFFSET
3695	    SetValue_iv(db->array_base, "ArrayBase") ;
3696	    db->array_base = (db->array_base == 0 ? 1 : 0) ;
3697#endif /* ALLOW_RECNO_OFFSET */
3698
3699	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3700                    DB_RECNO, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3701	}
3702	OUTPUT:
3703	    RETVAL
3704
3705
3706MODULE = BerkeleyDB::Queue	PACKAGE = BerkeleyDB::Queue	PREFIX = recno_
3707
3708BerkeleyDB::Queue::Raw
3709_db_open_queue(self, ref)
3710	char *		self
3711	SV * 		ref
3712	PREINIT:
3713	  dMY_CXT;
3714	CODE:
3715	{
3716#ifndef AT_LEAST_DB_3
3717            softCrash("BerkeleyDB::Queue needs Berkeley DB 3.0.x or better");
3718#else
3719	    HV *		hash ;
3720	    SV * 		sv ;
3721	    DB_INFO 		info ;
3722	    BerkeleyDB__Env	dbenv = NULL;
3723	    SV *		ref_dbenv = NULL;
3724	    const char *	file = NULL ;
3725	    const char *	subname = NULL ;
3726	    int			flags = 0 ;
3727	    int			mode = 0 ;
3728    	    BerkeleyDB 		db ;
3729    	    BerkeleyDB__Txn 	txn = NULL ;
3730	    char *	enc_passwd = NULL ;
3731	    int		enc_flags = 0 ;
3732
3733	    hash = (HV*) SvRV(ref) ;
3734	    SetValue_pv(file, "Fname", char*) ;
3735	    SetValue_pv(subname, "Subname", char *) ;
3736	    SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3737	    ref_dbenv = sv ;
3738	    SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3739	    SetValue_iv(flags, "Flags") ;
3740	    SetValue_iv(mode, "Mode") ;
3741	    SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3742	    SetValue_iv(enc_flags, "Enc_Flags") ;
3743
3744       	    Zero(&info, 1, DB_INFO) ;
3745	    SetValue_iv(info.db_cachesize, "Cachesize") ;
3746	    SetValue_iv(info.db_lorder, "Lorder") ;
3747	    SetValue_iv(info.db_pagesize, "Pagesize") ;
3748	    SetValue_iv(info.bt_minkey, "Minkey") ;
3749    	    SetValue_iv(info.q_extentsize, "ExtentSize") ;
3750
3751
3752	    SetValue_iv(info.flags, "Property") ;
3753	    if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
3754		info.re_len = SvIV(sv) ; ;
3755		flagSet_DB2(info.flags, DB_FIXEDLEN) ;
3756	    }
3757	    if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
3758		info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3759		flagSet_DB2(info.flags, DB_PAD) ;
3760	    }
3761	    ZMALLOC(db, BerkeleyDB_type) ;
3762#ifdef ALLOW_RECNO_OFFSET
3763	    SetValue_iv(db->array_base, "ArrayBase") ;
3764	    db->array_base = (db->array_base == 0 ? 1 : 0) ;
3765#endif /* ALLOW_RECNO_OFFSET */
3766
3767	    RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3768                DB_QUEUE, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3769#endif
3770	}
3771	OUTPUT:
3772	    RETVAL
3773
3774HV *
3775db_stat(db, flags=0)
3776	int			flags
3777	BerkeleyDB::Common	db
3778	HV *			RETVAL = NULL ;
3779	PREINIT:
3780	  dMY_CXT;
3781	INIT:
3782	  ckActive_Database(db->active) ;
3783	CODE:
3784	{
3785#if DB_VERSION_MAJOR == 2
3786	    softCrash("$db->db_stat for a Queue needs Berkeley DB 3.x or better") ;
3787#else /* Berkeley DB 3, or better */
3788	    DB_QUEUE_STAT *	stat ;
3789#ifdef AT_LEAST_DB_4_3
3790	    db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3791#else
3792#ifdef AT_LEAST_DB_3_3
3793	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3794#else
3795	    db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3796#endif
3797#endif
3798	    if (db->Status) {
3799	        XSRETURN_UNDEF;
3800	    } else {
3801	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
3802		hv_store_iv(RETVAL, "qs_magic", stat->qs_magic) ;
3803		hv_store_iv(RETVAL, "qs_version", stat->qs_version);
3804#ifdef AT_LEAST_DB_3_1
3805		hv_store_iv(RETVAL, "qs_nkeys", stat->qs_nkeys);
3806		hv_store_iv(RETVAL, "qs_ndata", stat->qs_ndata);
3807#else
3808		hv_store_iv(RETVAL, "qs_nrecs", stat->qs_nrecs);
3809#endif
3810		hv_store_iv(RETVAL, "qs_pages", stat->qs_pages);
3811		hv_store_iv(RETVAL, "qs_pagesize", stat->qs_pagesize);
3812		hv_store_iv(RETVAL, "qs_pgfree", stat->qs_pgfree);
3813		hv_store_iv(RETVAL, "qs_re_len", stat->qs_re_len);
3814		hv_store_iv(RETVAL, "qs_re_pad", stat->qs_re_pad);
3815#ifdef AT_LEAST_DB_3_2
3816#else
3817		hv_store_iv(RETVAL, "qs_start", stat->qs_start);
3818#endif
3819		hv_store_iv(RETVAL, "qs_first_recno", stat->qs_first_recno);
3820		hv_store_iv(RETVAL, "qs_cur_recno", stat->qs_cur_recno);
3821#if DB_VERSION_MAJOR >= 3
3822		hv_store_iv(RETVAL, "qs_metaflags", stat->qs_metaflags);
3823#endif
3824		safefree(stat) ;
3825	    }
3826#endif
3827	}
3828	OUTPUT:
3829	    RETVAL
3830
3831
3832MODULE = BerkeleyDB::Common  PACKAGE = BerkeleyDB::Common	PREFIX = dab_
3833
3834
3835DualType
3836db_close(db,flags=0)
3837	int 			flags
3838        BerkeleyDB::Common 	db
3839	PREINIT:
3840	  dMY_CXT;
3841	INIT:
3842	    ckActive_Database(db->active) ;
3843	    saveCurrentDB(db) ;
3844	CODE:
3845	    Trace(("BerkeleyDB::Common::db_close %d\n", db));
3846#ifdef STRICT_CLOSE
3847	    if (db->txn)
3848		softCrash("attempted to close a database while a transaction was still open") ;
3849	    if (db->open_cursors)
3850		softCrash("attempted to close a database with %d open cursor(s)",
3851				db->open_cursors) ;
3852#ifdef AT_LEAST_DB_4_3
3853	    if (db->open_sequences)
3854		softCrash("attempted to close a database with %d open sequence(s)",
3855				db->open_sequences) ;
3856#endif /* AT_LEAST_DB_4_3 */
3857#endif /* STRICT_CLOSE */
3858	    RETVAL =  db->Status = ((db->dbp)->close)(db->dbp, flags) ;
3859	    if (db->parent_env && db->parent_env->open_dbs)
3860		-- db->parent_env->open_dbs ;
3861	    db->active = FALSE ;
3862	    hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
3863	    -- db->open_cursors ;
3864	    Trace(("end of BerkeleyDB::Common::db_close\n"));
3865	OUTPUT:
3866	    RETVAL
3867
3868void
3869dab__DESTROY(db)
3870	BerkeleyDB::Common	db
3871	PREINIT:
3872	  dMY_CXT;
3873	CODE:
3874	  saveCurrentDB(db) ;
3875	  Trace(("In BerkeleyDB::Common::_DESTROY db %d dirty=%d\n", db, PL_dirty)) ;
3876	  destroyDB(db) ;
3877	  Trace(("End of BerkeleyDB::Common::DESTROY \n")) ;
3878
3879#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
3880#define db_cursor(db, txn, cur,flags)  ((db->dbp)->cursor)(db->dbp, txn, cur)
3881#else
3882#define db_cursor(db, txn, cur,flags)  ((db->dbp)->cursor)(db->dbp, txn, cur,flags)
3883#endif
3884BerkeleyDB::Cursor::Raw
3885_db_cursor(db, flags=0)
3886	u_int32_t		flags
3887        BerkeleyDB::Common 	db
3888        BerkeleyDB::Cursor 	RETVAL = NULL ;
3889	PREINIT:
3890	  dMY_CXT;
3891	ALIAS: __db_write_cursor = 1
3892	INIT:
3893	    ckActive_Database(db->active) ;
3894	CODE:
3895	{
3896	  DBC *	cursor ;
3897	  saveCurrentDB(db) ;
3898	  if (ix == 1 && db->cds_enabled) {
3899#ifdef AT_LEAST_DB_3
3900	      flags |= DB_WRITECURSOR;
3901#else
3902	      flags |= DB_RMW;
3903#endif
3904	  }
3905	  if ((db->Status = db_cursor(db, db->txn, &cursor, flags)) == 0){
3906	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
3907	      db->open_cursors ++ ;
3908	      RETVAL->parent_db  = db ;
3909	      RETVAL->cursor  = cursor ;
3910	      RETVAL->dbp     = db->dbp ;
3911	      RETVAL->txn     = db->txn ;
3912              RETVAL->type    = db->type ;
3913              RETVAL->recno_or_queue    = db->recno_or_queue ;
3914              RETVAL->cds_enabled    = db->cds_enabled ;
3915              RETVAL->filename    = my_strdup(db->filename) ;
3916              RETVAL->compare = db->compare ;
3917              RETVAL->dup_compare = db->dup_compare ;
3918#ifdef AT_LEAST_DB_3_3
3919              RETVAL->associated = db->associated ;
3920	      RETVAL->secondary_db  = db->secondary_db;
3921              RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
3922#endif
3923#ifdef AT_LEAST_DB_4_8
3924              RETVAL->associated_foreign = db->associated_foreign ;
3925#endif
3926              RETVAL->prefix  = db->prefix ;
3927              RETVAL->hash    = db->hash ;
3928	      RETVAL->partial = db->partial ;
3929	      RETVAL->doff    = db->doff ;
3930	      RETVAL->dlen    = db->dlen ;
3931	      RETVAL->active  = TRUE ;
3932#ifdef ALLOW_RECNO_OFFSET
3933	      RETVAL->array_base  = db->array_base ;
3934#endif /* ALLOW_RECNO_OFFSET */
3935#ifdef DBM_FILTERING
3936	      RETVAL->filtering   = FALSE ;
3937	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
3938	      RETVAL->filter_store_key    = db->filter_store_key ;
3939	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
3940	      RETVAL->filter_store_value  = db->filter_store_value ;
3941#endif
3942              /* RETVAL->info ; */
3943	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
3944	  }
3945	}
3946	OUTPUT:
3947	  RETVAL
3948
3949BerkeleyDB::Cursor::Raw
3950_db_join(db, cursors, flags=0)
3951	u_int32_t		flags
3952        BerkeleyDB::Common 	db
3953	AV *			cursors
3954        BerkeleyDB::Cursor 	RETVAL = NULL ;
3955	PREINIT:
3956	  dMY_CXT;
3957	INIT:
3958	    ckActive_Database(db->active) ;
3959	CODE:
3960	{
3961#if DB_VERSION_MAJOR == 2 && (DB_VERSION_MINOR < 5 || (DB_VERSION_MINOR == 5 && DB_VERSION_PATCH < 2))
3962	    softCrash("join needs Berkeley DB 2.5.2 or later") ;
3963#else /* Berkeley DB >= 2.5.2 */
3964	  DBC *		join_cursor ;
3965	  DBC **	cursor_list ;
3966	  I32		count = av_len(cursors) + 1 ;
3967	  int		i ;
3968	  saveCurrentDB(db) ;
3969	  if (count < 1 )
3970	      softCrash("db_join: No cursors in parameter list") ;
3971	  cursor_list = (DBC **)safemalloc(sizeof(DBC*) * (count + 1));
3972	  for (i = 0 ; i < count ; ++i) {
3973	      SV * obj = (SV*) * av_fetch(cursors, i, FALSE) ;
3974	      IV tmp = SvIV(getInnerObject(obj)) ;
3975	      BerkeleyDB__Cursor cur = INT2PTR(BerkeleyDB__Cursor, tmp);
3976	      if (cur->dbp == db->dbp)
3977	          softCrash("attempted to do a self-join");
3978	      cursor_list[i] = cur->cursor ;
3979	  }
3980	  cursor_list[i] = NULL ;
3981#if DB_VERSION_MAJOR == 2
3982	  if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, flags, &join_cursor)) == 0){
3983#else
3984	  if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, &join_cursor, flags)) == 0){
3985#endif
3986	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
3987	      db->open_cursors ++ ;
3988	      RETVAL->parent_db  = db ;
3989	      RETVAL->cursor  = join_cursor ;
3990	      RETVAL->dbp     = db->dbp ;
3991              RETVAL->type    = db->type ;
3992              RETVAL->filename    = my_strdup(db->filename) ;
3993              RETVAL->compare = db->compare ;
3994              RETVAL->dup_compare = db->dup_compare ;
3995#ifdef AT_LEAST_DB_3_3
3996              RETVAL->associated = db->associated ;
3997	      RETVAL->secondary_db  = db->secondary_db;
3998              RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
3999#endif
4000#ifdef AT_LEAST_DB_4_8
4001              RETVAL->associated_foreign = db->associated_foreign ;
4002#endif
4003              RETVAL->prefix  = db->prefix ;
4004              RETVAL->hash    = db->hash ;
4005	      RETVAL->partial = db->partial ;
4006	      RETVAL->doff    = db->doff ;
4007	      RETVAL->dlen    = db->dlen ;
4008	      RETVAL->active  = TRUE ;
4009#ifdef ALLOW_RECNO_OFFSET
4010	      RETVAL->array_base  = db->array_base ;
4011#endif /* ALLOW_RECNO_OFFSET */
4012#ifdef DBM_FILTERING
4013	      RETVAL->filtering   = FALSE ;
4014	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
4015	      RETVAL->filter_store_key    = db->filter_store_key ;
4016	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
4017	      RETVAL->filter_store_value  = db->filter_store_value ;
4018#endif
4019              /* RETVAL->info ; */
4020	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
4021	  }
4022	  safefree(cursor_list) ;
4023#endif /* Berkeley DB >= 2.5.2 */
4024	}
4025	OUTPUT:
4026	  RETVAL
4027
4028int
4029ArrayOffset(db)
4030        BerkeleyDB::Common 	db
4031	PREINIT:
4032	  dMY_CXT;
4033	INIT:
4034	    ckActive_Database(db->active) ;
4035	CODE:
4036#ifdef ALLOW_RECNO_OFFSET
4037	    RETVAL = db->array_base ? 0 : 1 ;
4038#else
4039	    RETVAL = 0 ;
4040#endif /* ALLOW_RECNO_OFFSET */
4041	OUTPUT:
4042	    RETVAL
4043
4044
4045bool
4046cds_enabled(db)
4047        BerkeleyDB::Common 	db
4048	PREINIT:
4049	  dMY_CXT;
4050	INIT:
4051	    ckActive_Database(db->active) ;
4052	CODE:
4053	    RETVAL = db->cds_enabled ;
4054	OUTPUT:
4055	    RETVAL
4056
4057
4058int
4059stat_print(db, flags=0)
4060	BerkeleyDB::Common  db
4061	u_int32_t    flags
4062	INIT:
4063	  ckActive_Database(db->active) ;
4064	CODE:
4065#ifndef AT_LEAST_DB_4_3
4066		softCrash("$db->stat_print needs Berkeley DB 4.3 or better") ;
4067#else
4068		RETVAL = db->dbp->stat_print(db->dbp, flags);
4069#endif
4070	OUTPUT:
4071		RETVAL
4072
4073
4074int
4075type(db)
4076        BerkeleyDB::Common 	db
4077	PREINIT:
4078	  dMY_CXT;
4079	INIT:
4080	    ckActive_Database(db->active) ;
4081	CODE:
4082	    RETVAL = db->type ;
4083	OUTPUT:
4084	    RETVAL
4085
4086int
4087byteswapped(db)
4088        BerkeleyDB::Common 	db
4089	PREINIT:
4090	  dMY_CXT;
4091	INIT:
4092	    ckActive_Database(db->active) ;
4093	CODE:
4094#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
4095	    softCrash("byteswapped needs Berkeley DB 2.5 or later") ;
4096#else
4097#if DB_VERSION_MAJOR == 2
4098	    RETVAL = db->dbp->byteswapped ;
4099#else
4100#ifdef AT_LEAST_DB_3_3
4101	    db->dbp->get_byteswapped(db->dbp, &RETVAL) ;
4102#else
4103	    RETVAL = db->dbp->get_byteswapped(db->dbp) ;
4104#endif
4105#endif
4106#endif
4107	OUTPUT:
4108	    RETVAL
4109
4110DualType
4111status(db)
4112        BerkeleyDB::Common 	db
4113	PREINIT:
4114	  dMY_CXT;
4115	CODE:
4116	    RETVAL =  db->Status ;
4117	OUTPUT:
4118	    RETVAL
4119
4120#ifdef DBM_FILTERING
4121
4122#define setFilter(ftype)				\
4123	{						\
4124	    if (db->ftype)				\
4125	        RETVAL = sv_mortalcopy(db->ftype) ;	\
4126	    ST(0) = RETVAL ;				\
4127	    if (db->ftype && (code == &PL_sv_undef)) {	\
4128                SvREFCNT_dec(db->ftype) ;		\
4129	        db->ftype = NULL ;			\
4130	    }						\
4131	    else if (code) {				\
4132	        if (db->ftype)				\
4133	            sv_setsv(db->ftype, code) ;		\
4134	        else					\
4135	            db->ftype = newSVsv(code) ;		\
4136	    }	    					\
4137	}
4138
4139
4140SV *
4141filter_fetch_key(db, code)
4142	BerkeleyDB::Common		db
4143	SV *		code
4144	SV *		RETVAL = &PL_sv_undef ;
4145	CODE:
4146	    DBM_setFilter(db->filter_fetch_key, code) ;
4147
4148SV *
4149filter_store_key(db, code)
4150	BerkeleyDB::Common		db
4151	SV *		code
4152	SV *		RETVAL = &PL_sv_undef ;
4153	CODE:
4154	    DBM_setFilter(db->filter_store_key, code) ;
4155
4156SV *
4157filter_fetch_value(db, code)
4158	BerkeleyDB::Common		db
4159	SV *		code
4160	SV *		RETVAL = &PL_sv_undef ;
4161	CODE:
4162	    DBM_setFilter(db->filter_fetch_value, code) ;
4163
4164SV *
4165filter_store_value(db, code)
4166	BerkeleyDB::Common		db
4167	SV *		code
4168	SV *		RETVAL = &PL_sv_undef ;
4169	CODE:
4170	    DBM_setFilter(db->filter_store_value, code) ;
4171
4172#endif /* DBM_FILTERING */
4173
4174void
4175partial_set(db, offset, length)
4176        BerkeleyDB::Common 	db
4177	u_int32_t		offset
4178	u_int32_t		length
4179	PREINIT:
4180	  dMY_CXT;
4181	INIT:
4182	    ckActive_Database(db->active) ;
4183	PPCODE:
4184	    if (GIMME == G_ARRAY) {
4185		XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
4186		XPUSHs(sv_2mortal(newSViv(db->doff))) ;
4187		XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
4188	    }
4189	    db->partial = DB_DBT_PARTIAL ;
4190	    db->doff    = offset ;
4191	    db->dlen    = length ;
4192
4193
4194void
4195partial_clear(db)
4196        BerkeleyDB::Common 	db
4197	PREINIT:
4198	  dMY_CXT;
4199	INIT:
4200	    ckActive_Database(db->active) ;
4201	PPCODE:
4202	    if (GIMME == G_ARRAY) {
4203		XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
4204		XPUSHs(sv_2mortal(newSViv(db->doff))) ;
4205		XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
4206	    }
4207	    db->partial =
4208	    db->doff    =
4209	    db->dlen    = 0 ;
4210
4211
4212#define db_del(db, key, flags)  \
4213	(db->Status = ((db->dbp)->del)(db->dbp, db->txn, &key, flags))
4214DualType
4215db_del(db, key, flags=0)
4216	u_int		flags
4217	BerkeleyDB::Common	db
4218	DBTKEY		key
4219	PREINIT:
4220	  dMY_CXT;
4221	INIT:
4222	    Trace(("db_del db[%p] in [%p] txn[%p] key[%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
4223	    ckActive_Database(db->active) ;
4224	    saveCurrentDB(db) ;
4225
4226
4227#ifdef AT_LEAST_DB_3
4228#  ifdef AT_LEAST_DB_3_2
4229#    define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_CONSUME_WAIT)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4230#  else
4231#    define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4232#  endif
4233#else
4234#define writeToKey() (flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4235#endif
4236#define db_get(db, key, data, flags)   \
4237	(db->Status = ((db->dbp)->get)(db->dbp, db->txn, &key, &data, flags))
4238DualType
4239db_get(db, key, data, flags=0)
4240	u_int		flags
4241	BerkeleyDB::Common	db
4242	DBTKEY_B	key
4243	DBT_OPT		data
4244	PREINIT:
4245	  dMY_CXT;
4246	CODE:
4247	  ckActive_Database(db->active) ;
4248	  saveCurrentDB(db) ;
4249	  SetPartial(data,db) ;
4250	  Trace(("db_get db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
4251	  RETVAL = db_get(db, key, data, flags);
4252	  Trace(("  RETVAL %d\n", RETVAL));
4253	OUTPUT:
4254	  RETVAL
4255	  key	if (writeToKey()) OutputKey(ST(1), key) ;
4256	  data
4257
4258#define db_pget(db, key, pkey, data, flags)   \
4259	(db->Status = ((db->dbp)->pget)(db->dbp, db->txn, &key, &pkey, &data, flags))
4260DualType
4261db_pget(db, key, pkey, data, flags=0)
4262	u_int		flags
4263	BerkeleyDB::Common	db
4264	DBTKEY_B	key
4265	DBTKEY_Bpr	pkey = NO_INIT
4266	DBT_OPT		data
4267	PREINIT:
4268	  dMY_CXT;
4269	CODE:
4270#ifndef AT_LEAST_DB_3_3
4271          softCrash("db_pget needs at least Berkeley DB 3.3");
4272#else
4273	  Trace(("db_pget db [%p] in [%p] txn [%p] flags [%d]\n", db->dbp, db, db->txn, flags)) ;
4274	  ckActive_Database(db->active) ;
4275	  saveCurrentDB(db) ;
4276	  SetPartial(data,db) ;
4277	  DBT_clear(pkey);
4278	  RETVAL = db_pget(db, key, pkey, data, flags);
4279	  Trace(("  RETVAL %d\n", RETVAL));
4280#endif
4281	OUTPUT:
4282	  RETVAL
4283	  key	if (writeToKey()) OutputKey(ST(1), key) ;
4284	  pkey
4285	  data
4286
4287#define db_put(db,key,data,flag)	\
4288		(db->Status = (db->dbp->put)(db->dbp,db->txn,&key,&data,flag))
4289DualType
4290db_put(db, key, data, flags=0)
4291	u_int			flags
4292	BerkeleyDB::Common	db
4293	DBTKEY			key
4294	DBT			data
4295	PREINIT:
4296	  dMY_CXT;
4297	CODE:
4298	  ckActive_Database(db->active) ;
4299	  saveCurrentDB(db) ;
4300	  /* SetPartial(data,db) ; */
4301	  Trace(("db_put db[%p] in [%p] txn[%p] key[%.*s] data [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, data.size, data.data, flags)) ;
4302	  RETVAL = db_put(db, key, data, flags);
4303	  Trace(("  RETVAL %d\n", RETVAL));
4304	OUTPUT:
4305	  RETVAL
4306	  key	if (flagSet(DB_APPEND)) OutputKey(ST(1), key) ;
4307
4308#define db_key_range(db, key, range, flags)   \
4309	(db->Status = ((db->dbp)->key_range)(db->dbp, db->txn, &key, &range, flags))
4310DualType
4311db_key_range(db, key, less, equal, greater, flags=0)
4312	u_int32_t	flags
4313	BerkeleyDB::Common	db
4314	DBTKEY_B	key
4315	double          less = 0.0 ;
4316	double          equal = 0.0 ;
4317	double          greater = 0.0 ;
4318	PREINIT:
4319	  dMY_CXT;
4320	CODE:
4321	{
4322#ifndef AT_LEAST_DB_3_1
4323          softCrash("key_range needs Berkeley DB 3.1.x or later") ;
4324#else
4325          DB_KEY_RANGE range ;
4326          range.less = range.equal = range.greater = 0.0 ;
4327	  ckActive_Database(db->active) ;
4328	  saveCurrentDB(db) ;
4329	  RETVAL = db_key_range(db, key, range, flags);
4330	  if (RETVAL == 0) {
4331	        less = range.less ;
4332	        equal = range.equal;
4333	        greater = range.greater;
4334	  }
4335#endif
4336	}
4337	OUTPUT:
4338	  RETVAL
4339	  less
4340	  equal
4341	  greater
4342
4343
4344#define db_fd(d, x)	(db->Status = (db->dbp->fd)(db->dbp, &x))
4345int
4346db_fd(db)
4347	BerkeleyDB::Common	db
4348	PREINIT:
4349	  dMY_CXT;
4350	INIT:
4351	  ckActive_Database(db->active) ;
4352	CODE:
4353	  saveCurrentDB(db) ;
4354	  db_fd(db, RETVAL) ;
4355	OUTPUT:
4356	  RETVAL
4357
4358
4359#define db_sync(db, fl)	(db->Status = (db->dbp->sync)(db->dbp, fl))
4360DualType
4361db_sync(db, flags=0)
4362	u_int			flags
4363	BerkeleyDB::Common	db
4364	PREINIT:
4365	  dMY_CXT;
4366	INIT:
4367	  ckActive_Database(db->active) ;
4368	  saveCurrentDB(db) ;
4369
4370void
4371_Txn(db, txn=NULL)
4372        BerkeleyDB::Common      db
4373        BerkeleyDB::Txn         txn
4374	PREINIT:
4375	  dMY_CXT;
4376	INIT:
4377	  ckActive_Database(db->active) ;
4378	CODE:
4379	   if (txn) {
4380	       Trace(("_Txn[%p] in[%p] active [%d]\n", txn->txn, txn, txn->active));
4381	       ckActive_Transaction(txn->active) ;
4382	       db->txn = txn->txn ;
4383	   }
4384	   else {
4385	       Trace(("_Txn[undef] \n"));
4386	       db->txn = NULL ;
4387	   }
4388
4389
4390#define db_truncate(db, countp, flags)  \
4391	(db->Status = ((db->dbp)->truncate)(db->dbp, db->txn, &countp, flags))
4392DualType
4393truncate(db, countp, flags=0)
4394	BerkeleyDB::Common	db
4395	u_int32_t		countp
4396	u_int32_t		flags
4397	PREINIT:
4398	  dMY_CXT;
4399	INIT:
4400	  ckActive_Database(db->active) ;
4401	CODE:
4402#ifndef AT_LEAST_DB_3_3
4403          softCrash("truncate needs Berkeley DB 3.3 or later") ;
4404#else
4405	  saveCurrentDB(db) ;
4406	  RETVAL = db_truncate(db, countp, flags);
4407#endif
4408	OUTPUT:
4409	  RETVAL
4410	  countp
4411
4412#ifdef AT_LEAST_DB_4_1
4413#  define db_associate(db, sec, cb, flags)\
4414	(db->Status = ((db->dbp)->associate)(db->dbp, db->txn, sec->dbp, &cb, flags))
4415#else
4416#  define db_associate(db, sec, cb, flags)\
4417	(db->Status = ((db->dbp)->associate)(db->dbp, sec->dbp, &cb, flags))
4418#endif
4419DualType
4420associate(db, secondary, callback, flags=0)
4421	BerkeleyDB::Common	db
4422	BerkeleyDB::Common	secondary
4423	SV*			callback
4424	u_int32_t		flags
4425	PREINIT:
4426	  dMY_CXT;
4427	INIT:
4428	  ckActive_Database(db->active) ;
4429	CODE:
4430#ifndef AT_LEAST_DB_3_3
4431          softCrash("associate needs Berkeley DB 3.3 or later") ;
4432#else
4433	  saveCurrentDB(db) ;
4434	  /* db->associated = newSVsv(callback) ; */
4435	  secondary->associated = newSVsv(callback) ;
4436	  secondary->primary_recno_or_queue = db->recno_or_queue ;
4437	  /* secondary->dbp->app_private = secondary->associated ; */
4438	  secondary->secondary_db = TRUE;
4439      if (secondary->recno_or_queue)
4440          RETVAL = db_associate(db, secondary, associate_cb_recno, flags);
4441      else
4442          RETVAL = db_associate(db, secondary, associate_cb, flags);
4443#endif
4444	OUTPUT:
4445	  RETVAL
4446
4447#define db_associate_foreign(db, sec, cb, flags)\
4448	(db->Status = ((db->dbp)->associate_foreign)(db->dbp, sec->dbp, cb, flags))
4449DualType
4450associate_foreign(db, secondary, callback, flags)
4451	BerkeleyDB::Common	db
4452	BerkeleyDB::Common	secondary
4453	SV*			callback
4454	u_int32_t		flags
4455    foreign_cb_type callback_ptr = NULL;
4456	PREINIT:
4457	  dMY_CXT;
4458	INIT:
4459	  ckActive_Database(db->active) ;
4460	CODE:
4461#ifndef AT_LEAST_DB_4_8
4462          softCrash("associate_foreign needs Berkeley DB 4.8 or later") ;
4463#else
4464	  saveCurrentDB(db) ;
4465	  if (callback != &PL_sv_undef)
4466	  {
4467          //softCrash("associate_foreign does not support callbacks yet") ;
4468          secondary->associated_foreign = newSVsv(callback) ;
4469          callback_ptr = ( secondary->recno_or_queue
4470                                ? associate_foreign_cb_recno
4471                                : associate_foreign_cb);
4472	  }
4473	  secondary->primary_recno_or_queue = db->recno_or_queue ;
4474	  secondary->secondary_db = TRUE;
4475      RETVAL = db_associate_foreign(db, secondary, callback_ptr, flags);
4476#endif
4477	OUTPUT:
4478	  RETVAL
4479
4480DualType
4481compact(db, start=NULL, stop=NULL, c_data=NULL, flags=0, end=NULL)
4482	PREINIT:
4483	  dMY_CXT;
4484    PREINIT:
4485        DBTKEY	    end_key;
4486    INPUT:
4487	BerkeleyDB::Common	db
4488	SVnull*   	    start
4489	SVnull*   	    stop
4490	SVnull*   	    c_data
4491	u_int32_t	flags
4492	SVnull*   	    end
4493	CODE:
4494    {
4495#ifndef AT_LEAST_DB_4_4
4496          softCrash("compact needs Berkeley DB 4.4 or later") ;
4497#else
4498        DBTKEY	    start_key;
4499        DBTKEY	    stop_key;
4500        DBTKEY*	    start_p = NULL;
4501        DBTKEY*	    stop_p = NULL;
4502        DBTKEY*	    end_p = NULL;
4503	    DB_COMPACT cmpt;
4504	    DB_COMPACT* cmpt_p = NULL;
4505	    SV * sv;
4506        HV* hash = NULL;
4507
4508        DBT_clear(start_key);
4509        DBT_clear(stop_key);
4510        DBT_clear(end_key);
4511        Zero(&cmpt, 1, DB_COMPACT) ;
4512        ckActive_Database(db->active) ;
4513        saveCurrentDB(db) ;
4514        if (start && SvOK(start)) {
4515            start_p = &start_key;
4516            DBM_ckFilter(start, filter_store_key, "filter_store_key");
4517            GetKey(db, start, start_p);
4518        }
4519        if (stop && SvOK(stop)) {
4520            stop_p = &stop_key;
4521            DBM_ckFilter(stop, filter_store_key, "filter_store_key");
4522            GetKey(db, stop, stop_p);
4523        }
4524        if (end) {
4525            end_p = &end_key;
4526        }
4527        if (c_data && SvOK(c_data)) {
4528            hash = (HV*) SvRV(c_data) ;
4529            cmpt_p = & cmpt;
4530            cmpt.compact_fillpercent = GetValue_iv(hash,"compact_fillpercent") ;
4531            cmpt.compact_timeout = (db_timeout_t) GetValue_iv(hash, "compact_timeout");
4532        }
4533        RETVAL = (db->dbp)->compact(db->dbp, db->txn, start_p, stop_p, cmpt_p, flags, end_p);
4534        if (RETVAL == 0 && hash) {
4535            hv_store_iv(hash, "compact_deadlock", cmpt.compact_deadlock) ;
4536            hv_store_iv(hash, "compact_levels",   cmpt.compact_levels) ;
4537            hv_store_iv(hash, "compact_pages_free", cmpt.compact_pages_free) ;
4538            hv_store_iv(hash, "compact_pages_examine", cmpt.compact_pages_examine) ;
4539            hv_store_iv(hash, "compact_pages_truncated", cmpt.compact_pages_truncated) ;
4540        }
4541#endif
4542    }
4543	OUTPUT:
4544	  RETVAL
4545	  end		if (RETVAL == 0 && end) OutputValue_B(ST(5), end_key) ;
4546
4547
4548MODULE = BerkeleyDB::Cursor              PACKAGE = BerkeleyDB::Cursor	PREFIX = cu_
4549
4550BerkeleyDB::Cursor::Raw
4551_c_dup(db, flags=0)
4552	u_int32_t		flags
4553    	BerkeleyDB::Cursor	db
4554        BerkeleyDB::Cursor 	RETVAL = NULL ;
4555	PREINIT:
4556	  dMY_CXT;
4557	INIT:
4558	    saveCurrentDB(db->parent_db);
4559	    ckActive_Database(db->active) ;
4560	CODE:
4561	{
4562#ifndef AT_LEAST_DB_3
4563          softCrash("c_dup needs at least Berkeley DB 3.0.x");
4564#else
4565	  DBC *		newcursor ;
4566	  db->Status = ((db->cursor)->c_dup)(db->cursor, &newcursor, flags) ;
4567	  if (db->Status == 0){
4568	      ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
4569	      db->parent_db->open_cursors ++ ;
4570	      RETVAL->parent_db  = db->parent_db ;
4571	      RETVAL->cursor  = newcursor ;
4572	      RETVAL->dbp     = db->dbp ;
4573              RETVAL->type    = db->type ;
4574              RETVAL->recno_or_queue    = db->recno_or_queue ;
4575              RETVAL->primary_recno_or_queue    = db->primary_recno_or_queue ;
4576              RETVAL->cds_enabled    = db->cds_enabled ;
4577              RETVAL->filename    = my_strdup(db->filename) ;
4578              RETVAL->compare = db->compare ;
4579              RETVAL->dup_compare = db->dup_compare ;
4580#ifdef AT_LEAST_DB_3_3
4581              RETVAL->associated = db->associated ;
4582#endif
4583#ifdef AT_LEAST_DB_4_8
4584              RETVAL->associated_foreign = db->associated_foreign ;
4585#endif
4586              RETVAL->prefix  = db->prefix ;
4587              RETVAL->hash    = db->hash ;
4588	      RETVAL->partial = db->partial ;
4589	      RETVAL->doff    = db->doff ;
4590	      RETVAL->dlen    = db->dlen ;
4591	      RETVAL->active  = TRUE ;
4592#ifdef ALLOW_RECNO_OFFSET
4593	      RETVAL->array_base  = db->array_base ;
4594#endif /* ALLOW_RECNO_OFFSET */
4595#ifdef DBM_FILTERING
4596	      RETVAL->filtering   = FALSE ;
4597	      RETVAL->filter_fetch_key    = db->filter_fetch_key ;
4598	      RETVAL->filter_store_key    = db->filter_store_key ;
4599	      RETVAL->filter_fetch_value  = db->filter_fetch_value ;
4600	      RETVAL->filter_store_value  = db->filter_store_value ;
4601#endif /* DBM_FILTERING */
4602              /* RETVAL->info ; */
4603	      hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
4604	  }
4605#endif
4606	}
4607	OUTPUT:
4608	  RETVAL
4609
4610DualType
4611_c_close(db)
4612    BerkeleyDB::Cursor	db
4613	PREINIT:
4614	  dMY_CXT;
4615	INIT:
4616	  saveCurrentDB(db->parent_db);
4617	  ckActive_Cursor(db->active) ;
4618	  hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
4619	CODE:
4620	  RETVAL =  db->Status =
4621    	          ((db->cursor)->c_close)(db->cursor) ;
4622	  db->active = FALSE ;
4623	  if (db->parent_db->open_cursors)
4624	      -- db->parent_db->open_cursors ;
4625	OUTPUT:
4626	  RETVAL
4627
4628void
4629_DESTROY(db)
4630    BerkeleyDB::Cursor	db
4631	PREINIT:
4632	  dMY_CXT;
4633	CODE:
4634	  saveCurrentDB(db->parent_db);
4635	  Trace(("In BerkeleyDB::Cursor::_DESTROY db %d dirty=%d active=%d\n", db, PL_dirty, db->active));
4636	  hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
4637	  if (db->active)
4638    	      ((db->cursor)->c_close)(db->cursor) ;
4639	  if (db->parent_db->open_cursors)
4640	      -- db->parent_db->open_cursors ;
4641          Safefree(db->filename) ;
4642          Safefree(db) ;
4643	  Trace(("End of BerkeleyDB::Cursor::_DESTROY\n")) ;
4644
4645DualType
4646status(db)
4647        BerkeleyDB::Cursor 	db
4648	PREINIT:
4649	  dMY_CXT;
4650	CODE:
4651	    RETVAL =  db->Status ;
4652	OUTPUT:
4653	    RETVAL
4654
4655
4656#define cu_c_del(c,f)	(c->Status = ((c->cursor)->c_del)(c->cursor,f))
4657DualType
4658cu_c_del(db, flags=0)
4659    int			flags
4660    BerkeleyDB::Cursor	db
4661	PREINIT:
4662	  dMY_CXT;
4663	INIT:
4664	  saveCurrentDB(db->parent_db);
4665	  ckActive_Cursor(db->active) ;
4666	OUTPUT:
4667	  RETVAL
4668
4669
4670#define cu_c_get(c,k,d,f) (c->Status = (c->cursor->c_get)(c->cursor,&k,&d,f))
4671DualType
4672cu_c_get(db, key, data, flags=0)
4673    int			flags
4674    BerkeleyDB::Cursor	db
4675    DBTKEY_B		key
4676    DBT_B		data
4677	PREINIT:
4678	  dMY_CXT;
4679	INIT:
4680	  Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ;
4681	  saveCurrentDB(db->parent_db);
4682	  ckActive_Cursor(db->active) ;
4683	  /* DBT_clear(key); */
4684	  /* DBT_clear(data); */
4685	  SetPartial(data,db) ;
4686	  Trace(("c_get end\n")) ;
4687	OUTPUT:
4688	  RETVAL
4689	  key
4690	  data		if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ;
4691
4692#define cu_c_pget(c,k,p,d,f) (c->Status = (c->secondary_db ? (c->cursor->c_pget)(c->cursor,&k,&p,&d,f) : EINVAL))
4693DualType
4694cu_c_pget(db, key, pkey, data, flags=0)
4695    int			flags
4696    BerkeleyDB::Cursor	db
4697    DBTKEY_B		key
4698    DBTKEY_Bpr		pkey = NO_INIT
4699    DBT_B		data
4700	PREINIT:
4701	  dMY_CXT;
4702	CODE:
4703#ifndef AT_LEAST_DB_3_3
4704          softCrash("db_c_pget needs at least Berkeley DB 3.3");
4705#else
4706	  Trace(("c_pget db [%d] flags [%d]\n", db, flags)) ;
4707	  saveCurrentDB(db->parent_db);
4708	  ckActive_Cursor(db->active) ;
4709	  SetPartial(data,db) ;
4710	  DBT_clear(pkey);
4711	  RETVAL = cu_c_pget(db, key, pkey, data, flags);
4712	  Trace(("c_pget end\n")) ;
4713#endif
4714	OUTPUT:
4715	  RETVAL
4716	  key
4717	  pkey
4718	  data
4719
4720
4721
4722#define cu_c_put(c,k,d,f)  (c->Status = (c->cursor->c_put)(c->cursor,&k,&d,f))
4723DualType
4724cu_c_put(db, key, data, flags=0)
4725    int			flags
4726    BerkeleyDB::Cursor	db
4727    DBTKEY		key
4728    DBT			data
4729	PREINIT:
4730	  dMY_CXT;
4731	INIT:
4732	  saveCurrentDB(db->parent_db);
4733	  ckActive_Cursor(db->active) ;
4734	  /* SetPartial(data,db) ; */
4735	OUTPUT:
4736	  RETVAL
4737
4738#define cu_c_count(c,p,f) (c->Status = (c->cursor->c_count)(c->cursor,&p,f))
4739DualType
4740cu_c_count(db, count, flags=0)
4741    int			flags
4742    BerkeleyDB::Cursor	db
4743    u_int32_t           count = NO_INIT
4744	PREINIT:
4745	  dMY_CXT;
4746	CODE:
4747#ifndef AT_LEAST_DB_3_1
4748          softCrash("c_count needs at least Berkeley DB 3.1.x");
4749#else
4750	  Trace(("c_get count [%d] flags [%d]\n", db, flags)) ;
4751	  saveCurrentDB(db->parent_db);
4752	  ckActive_Cursor(db->active) ;
4753	  RETVAL = cu_c_count(db, count, flags) ;
4754	  Trace(("    c_count got %d duplicates\n", count)) ;
4755#endif
4756	OUTPUT:
4757	  RETVAL
4758	  count
4759
4760MODULE = BerkeleyDB::TxnMgr           PACKAGE = BerkeleyDB::TxnMgr	PREFIX = xx_
4761
4762BerkeleyDB::Txn::Raw
4763_txn_begin(txnmgr, pid=NULL, flags=0)
4764	u_int32_t		flags
4765	BerkeleyDB::TxnMgr	txnmgr
4766	BerkeleyDB::Txn		pid
4767	PREINIT:
4768	  dMY_CXT;
4769	CODE:
4770	{
4771	    DB_TXN *txn ;
4772	    DB_TXN *p_id = NULL ;
4773#if DB_VERSION_MAJOR == 2
4774	    if (txnmgr->env->Env->tx_info == NULL)
4775		softCrash("Transaction Manager not enabled") ;
4776#endif
4777	    if (pid)
4778		p_id = pid->txn ;
4779	    txnmgr->env->TxnMgrStatus =
4780#if DB_VERSION_MAJOR == 2
4781	    	txn_begin(txnmgr->env->Env->tx_info, p_id, &txn) ;
4782#else
4783#  ifdef AT_LEAST_DB_4
4784	    	txnmgr->env->Env->txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
4785#  else
4786	    	txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
4787#  endif
4788#endif
4789	    if (txnmgr->env->TxnMgrStatus == 0) {
4790	      ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
4791	      RETVAL->txn  = txn ;
4792	      RETVAL->active = TRUE ;
4793	      Trace(("_txn_begin created txn [%d] in [%d]\n", txn, RETVAL));
4794	      hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
4795	    }
4796	    else
4797		RETVAL = NULL ;
4798	}
4799	OUTPUT:
4800	    RETVAL
4801
4802
4803DualType
4804status(mgr)
4805        BerkeleyDB::TxnMgr 	mgr
4806	PREINIT:
4807	  dMY_CXT;
4808	CODE:
4809	    RETVAL =  mgr->env->TxnMgrStatus ;
4810	OUTPUT:
4811	    RETVAL
4812
4813
4814void
4815_DESTROY(mgr)
4816    BerkeleyDB::TxnMgr	mgr
4817	PREINIT:
4818	  dMY_CXT;
4819	CODE:
4820	  Trace(("In BerkeleyDB::TxnMgr::DESTROY dirty=%d\n", PL_dirty)) ;
4821          Safefree(mgr) ;
4822	  Trace(("End of BerkeleyDB::TxnMgr::DESTROY\n")) ;
4823
4824DualType
4825txn_close(txnp)
4826	BerkeleyDB::TxnMgr	txnp
4827        NOT_IMPLEMENTED_YET
4828
4829
4830#if DB_VERSION_MAJOR == 2
4831#  define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env->tx_info, k, m)
4832#else
4833#  ifdef AT_LEAST_DB_4
4834#    define xx_txn_checkpoint(e,k,m,f) e->env->Env->txn_checkpoint(e->env->Env, k, m, f)
4835#  else
4836#    ifdef AT_LEAST_DB_3_1
4837#      define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m, 0)
4838#    else
4839#      define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m)
4840#    endif
4841#  endif
4842#endif
4843DualType
4844xx_txn_checkpoint(txnp, kbyte, min, flags=0)
4845	BerkeleyDB::TxnMgr	txnp
4846	long			kbyte
4847	long			min
4848	u_int32_t		flags
4849	PREINIT:
4850	  dMY_CXT;
4851
4852HV *
4853txn_stat(txnp)
4854	BerkeleyDB::TxnMgr	txnp
4855	HV *			RETVAL = NULL ;
4856	PREINIT:
4857	  dMY_CXT;
4858	CODE:
4859	{
4860	    DB_TXN_STAT *	stat ;
4861#ifdef AT_LEAST_DB_4
4862	    if(txnp->env->Env->txn_stat(txnp->env->Env, &stat, 0) == 0) {
4863#else
4864#  ifdef AT_LEAST_DB_3_3
4865	    if(txn_stat(txnp->env->Env, &stat) == 0) {
4866#  else
4867#    if DB_VERSION_MAJOR == 2
4868	    if(txn_stat(txnp->env->Env->tx_info, &stat, safemalloc) == 0) {
4869#    else
4870	    if(txn_stat(txnp->env->Env, &stat, safemalloc) == 0) {
4871#    endif
4872#  endif
4873#endif
4874	    	RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
4875		hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
4876		hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
4877		hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
4878		hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
4879		hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
4880		hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
4881		hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
4882#if DB_VERSION_MAJOR > 2
4883		hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
4884		hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
4885		hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
4886		hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
4887#endif
4888		safefree(stat) ;
4889	    }
4890	}
4891	OUTPUT:
4892	    RETVAL
4893
4894
4895BerkeleyDB::TxnMgr
4896txn_open(dir, flags, mode, dbenv)
4897    int 		flags
4898    const char *	dir
4899    int 		mode
4900    BerkeleyDB::Env 	dbenv
4901        NOT_IMPLEMENTED_YET
4902
4903
4904MODULE = BerkeleyDB::Txn              PACKAGE = BerkeleyDB::Txn		PREFIX = xx_
4905
4906DualType
4907status(tid)
4908        BerkeleyDB::Txn 	tid
4909	PREINIT:
4910	  dMY_CXT;
4911	CODE:
4912	    RETVAL =  tid->Status ;
4913	OUTPUT:
4914	    RETVAL
4915
4916int
4917set_timeout(txn, timeout, flags=0)
4918        BerkeleyDB::Txn txn
4919	db_timeout_t	 timeout
4920	u_int32_t	 flags
4921	PREINIT:
4922	  dMY_CXT;
4923	INIT:
4924	    ckActive_Transaction(txn->active) ;
4925	CODE:
4926#ifndef AT_LEAST_DB_4
4927	    softCrash("$env->set_timeout needs Berkeley DB 4.x or better") ;
4928#else
4929	    RETVAL = txn->Status = txn->txn->set_timeout(txn->txn, timeout, flags);
4930#endif
4931	OUTPUT:
4932	    RETVAL
4933
4934int
4935set_tx_max(txn, max)
4936        BerkeleyDB::Txn txn
4937	u_int32_t	 max
4938	PREINIT:
4939	  dMY_CXT;
4940	INIT:
4941	    ckActive_Transaction(txn->active) ;
4942	CODE:
4943#ifndef AT_LEAST_DB_2_3
4944	    softCrash("$env->set_tx_max needs Berkeley DB 2_3.x or better") ;
4945#else
4946	    RETVAL = txn->Status = txn->txn->set_tx_max(txn->txn, max);
4947#endif
4948	OUTPUT:
4949	    RETVAL
4950
4951int
4952get_tx_max(txn, max)
4953        BerkeleyDB::Txn txn
4954	u_int32_t	 max = NO_INIT
4955	PREINIT:
4956	  dMY_CXT;
4957	INIT:
4958	    ckActive_Transaction(txn->active) ;
4959	CODE:
4960#ifndef AT_LEAST_DB_2_3
4961	    softCrash("$env->get_tx_max needs Berkeley DB 2_3.x or better") ;
4962#else
4963	    RETVAL = txn->Status = txn->txn->get_tx_max(txn->txn, &max);
4964#endif
4965	OUTPUT:
4966	    RETVAL
4967	    max
4968
4969void
4970_DESTROY(tid)
4971    BerkeleyDB::Txn	tid
4972	PREINIT:
4973	  dMY_CXT;
4974	CODE:
4975	  Trace(("In BerkeleyDB::Txn::_DESTROY txn [%d] active [%d] dirty=%d\n", tid->txn, tid->active, PL_dirty)) ;
4976	  if (tid->active)
4977#ifdef AT_LEAST_DB_4
4978	    tid->txn->abort(tid->txn) ;
4979#else
4980	    txn_abort(tid->txn) ;
4981#endif
4982	  hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
4983          Safefree(tid) ;
4984	  Trace(("End of BerkeleyDB::Txn::DESTROY\n")) ;
4985
4986#define xx_txn_unlink(d,f,e)	txn_unlink(d,f,&(e->Env))
4987DualType
4988xx_txn_unlink(dir, force, dbenv)
4989    const char *	dir
4990    int 		force
4991    BerkeleyDB::Env 	dbenv
4992        NOT_IMPLEMENTED_YET
4993
4994#ifdef AT_LEAST_DB_4
4995#  define xx_txn_prepare(t) (t->Status = t->txn->prepare(t->txn, 0))
4996#else
4997#  ifdef AT_LEAST_DB_3_3
4998#    define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn, 0))
4999#  else
5000#    define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn))
5001#  endif
5002#endif
5003DualType
5004xx_txn_prepare(tid)
5005	BerkeleyDB::Txn	tid
5006	PREINIT:
5007	  dMY_CXT;
5008	INIT:
5009	    ckActive_Transaction(tid->active) ;
5010
5011#ifdef AT_LEAST_DB_4
5012#  define _txn_commit(t,flags) (t->Status = t->txn->commit(t->txn, flags))
5013#else
5014#  if DB_VERSION_MAJOR == 2
5015#    define _txn_commit(t,flags) (t->Status = txn_commit(t->txn))
5016#  else
5017#    define _txn_commit(t, flags) (t->Status = txn_commit(t->txn, flags))
5018#  endif
5019#endif
5020DualType
5021_txn_commit(tid, flags=0)
5022	u_int32_t	flags
5023	BerkeleyDB::Txn	tid
5024	PREINIT:
5025	  dMY_CXT;
5026	INIT:
5027	    ckActive_Transaction(tid->active) ;
5028	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5029	    tid->active = FALSE ;
5030
5031#ifdef AT_LEAST_DB_4
5032#  define _txn_abort(t) (t->Status = t->txn->abort(t->txn))
5033#else
5034#  define _txn_abort(t) (t->Status = txn_abort(t->txn))
5035#endif
5036DualType
5037_txn_abort(tid)
5038	BerkeleyDB::Txn	tid
5039	PREINIT:
5040	  dMY_CXT;
5041	INIT:
5042	    ckActive_Transaction(tid->active) ;
5043	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5044	    tid->active = FALSE ;
5045
5046#ifdef AT_LEAST_DB_4
5047#  define _txn_discard(t,f) (t->Status = t->txn->discard(t->txn, f))
5048#else
5049#  ifdef AT_LEAST_DB_3_3_4
5050#    define _txn_discard(t,f) (t->Status = txn_discard(t->txn, f))
5051#  else
5052#    define _txn_discard(t,f) (int)softCrash("txn_discard needs Berkeley DB 3.3.4 or better") ;
5053#  endif
5054#endif
5055DualType
5056_txn_discard(tid, flags=0)
5057	BerkeleyDB::Txn	tid
5058	u_int32_t       flags
5059	PREINIT:
5060	  dMY_CXT;
5061	INIT:
5062	    ckActive_Transaction(tid->active) ;
5063	    hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5064	    tid->active = FALSE ;
5065
5066#ifdef AT_LEAST_DB_4
5067#  define xx_txn_id(t) t->txn->id(t->txn)
5068#else
5069#  define xx_txn_id(t) txn_id(t->txn)
5070#endif
5071u_int32_t
5072xx_txn_id(tid)
5073	BerkeleyDB::Txn	tid
5074	PREINIT:
5075	  dMY_CXT;
5076
5077MODULE = BerkeleyDB::_tiedHash        PACKAGE = BerkeleyDB::_tiedHash
5078
5079int
5080FIRSTKEY(db)
5081        BerkeleyDB::Common         db
5082	PREINIT:
5083	  dMY_CXT;
5084        CODE:
5085        {
5086            DBTKEY      key ;
5087            DBT         value ;
5088	    DBC *	cursor ;
5089
5090	    /*
5091		TODO!
5092		set partial value to 0 - to eliminate the retrieval of
5093		the value need to store any existing partial settings &
5094		restore at the end.
5095
5096	     */
5097            saveCurrentDB(db) ;
5098	    DBT_clear(key) ;
5099	    DBT_clear(value) ;
5100	    /* If necessary create a cursor for FIRSTKEY/NEXTKEY use */
5101	    if (!db->cursor &&
5102		(db->Status = db_cursor(db, db->txn, &cursor, 0)) == 0 )
5103	            db->cursor  = cursor ;
5104
5105	    if (db->cursor)
5106	        RETVAL = (db->Status) =
5107		    ((db->cursor)->c_get)(db->cursor, &key, &value, DB_FIRST);
5108	    else
5109		RETVAL = db->Status ;
5110	    /* check for end of cursor */
5111	    if (RETVAL == DB_NOTFOUND) {
5112	      ((db->cursor)->c_close)(db->cursor) ;
5113	      db->cursor = NULL ;
5114	    }
5115            ST(0) = sv_newmortal();
5116	    OutputKey(ST(0), key)
5117        }
5118
5119
5120
5121int
5122NEXTKEY(db, key)
5123        BerkeleyDB::Common  db
5124        DBTKEY              key = NO_INIT
5125	PREINIT:
5126	  dMY_CXT;
5127        CODE:
5128        {
5129            DBT         value ;
5130
5131            saveCurrentDB(db) ;
5132	    DBT_clear(key) ;
5133	    DBT_clear(value) ;
5134	    key.flags = 0 ;
5135	    RETVAL = (db->Status) =
5136		((db->cursor)->c_get)(db->cursor, &key, &value, DB_NEXT);
5137
5138	    /* check for end of cursor */
5139	    if (RETVAL == DB_NOTFOUND) {
5140	      ((db->cursor)->c_close)(db->cursor) ;
5141	      db->cursor = NULL ;
5142	    }
5143            ST(0) = sv_newmortal();
5144	    OutputKey(ST(0), key)
5145        }
5146
5147MODULE = BerkeleyDB::_tiedArray        PACKAGE = BerkeleyDB::_tiedArray
5148
5149I32
5150FETCHSIZE(db)
5151        BerkeleyDB::Common         db
5152	PREINIT:
5153	  dMY_CXT;
5154        CODE:
5155            saveCurrentDB(db) ;
5156            RETVAL = GetArrayLength(db) ;
5157        OUTPUT:
5158            RETVAL
5159
5160
5161MODULE = BerkeleyDB::Common  PACKAGE = BerkeleyDB::Common
5162
5163BerkeleyDB::Sequence
5164db_create_sequence(db, flags=0)
5165    BerkeleyDB::Common  db
5166    u_int32_t		flags
5167    PREINIT:
5168      dMY_CXT;
5169    CODE:
5170    {
5171#ifndef AT_LEAST_DB_4_3
5172	    softCrash("$seq->create_sequence needs Berkeley DB 4.3.x or better") ;
5173#else
5174        DB_SEQUENCE *	seq ;
5175        saveCurrentDB(db);
5176        RETVAL = NULL;
5177        if (db_sequence_create(&seq, db->dbp, flags) == 0)
5178        {
5179            ZMALLOC(RETVAL, BerkeleyDB_Sequence_type);
5180            RETVAL->db = db;
5181            RETVAL->seq = seq;
5182            RETVAL->active = TRUE;
5183            ++ db->open_sequences ;
5184        }
5185#endif
5186    }
5187    OUTPUT:
5188      RETVAL
5189
5190
5191MODULE = BerkeleyDB::Sequence            PACKAGE = BerkeleyDB::Sequence PREFIX = seq_
5192
5193DualType
5194open(seq, key, flags=0)
5195    BerkeleyDB::Sequence seq
5196    DBTKEY_seq		 key
5197    u_int32_t            flags
5198    PREINIT:
5199        dMY_CXT;
5200    INIT:
5201        ckActive_Sequence(seq->active) ;
5202    CODE:
5203#ifndef AT_LEAST_DB_4_3
5204	    softCrash("$seq->create_sequence needs Berkeley DB 4.3.x or better") ;
5205#else
5206        RETVAL = seq->seq->open(seq->seq, seq->db->txn, &key, flags);
5207#endif
5208    OUTPUT:
5209        RETVAL
5210
5211DualType
5212close(seq,flags=0)
5213    BerkeleyDB::Sequence seq;
5214    u_int32_t            flags;
5215    PREINIT:
5216        dMY_CXT;
5217    INIT:
5218        ckActive_Sequence(seq->active) ;
5219    CODE:
5220#ifndef AT_LEAST_DB_4_3
5221	    softCrash("$seq->close needs Berkeley DB 4.3.x or better") ;
5222#else
5223        RETVAL = 0;
5224        if (seq->active) {
5225            -- seq->db->open_sequences;
5226            RETVAL = seq->seq->close(seq->seq, flags);
5227        }
5228        seq->active = FALSE;
5229#endif
5230    OUTPUT:
5231        RETVAL
5232
5233DualType
5234remove(seq,flags=0)
5235    BerkeleyDB::Sequence seq;
5236    u_int32_t            flags;
5237    PREINIT:
5238        dMY_CXT;
5239    INIT:
5240        ckActive_Sequence(seq->active) ;
5241    CODE:
5242#ifndef AT_LEAST_DB_4_3
5243	    softCrash("$seq->remove needs Berkeley DB 4.3.x or better") ;
5244#else
5245        RETVAL = 0;
5246        if (seq->active)
5247            RETVAL = seq->seq->remove(seq->seq, seq->db->txn, flags);
5248        seq->active = FALSE;
5249#endif
5250    OUTPUT:
5251        RETVAL
5252
5253void
5254DESTROY(seq)
5255    BerkeleyDB::Sequence seq
5256    PREINIT:
5257        dMY_CXT;
5258    CODE:
5259#ifdef AT_LEAST_DB_4_3
5260        if (seq->active)
5261            seq->seq->close(seq->seq, 0);
5262        Safefree(seq);
5263#endif
5264
5265DualType
5266get(seq, element, delta=1, flags=0)
5267    BerkeleyDB::Sequence seq;
5268    IV                   delta;
5269    db_seq_t             element = NO_INIT
5270    u_int32_t            flags;
5271    PREINIT:
5272        dMY_CXT;
5273    INIT:
5274        ckActive_Sequence(seq->active) ;
5275    CODE:
5276#ifndef AT_LEAST_DB_4_3
5277	    softCrash("$seq->get needs Berkeley DB 4.3.x or better") ;
5278#else
5279        RETVAL = seq->seq->get(seq->seq, seq->db->txn, delta, &element, flags);
5280#endif
5281    OUTPUT:
5282        RETVAL
5283        element
5284
5285DualType
5286get_key(seq, key)
5287    BerkeleyDB::Sequence seq;
5288    DBTKEY_seq		 key = NO_INIT
5289    PREINIT:
5290        dMY_CXT;
5291    INIT:
5292        ckActive_Sequence(seq->active) ;
5293    CODE:
5294#ifndef AT_LEAST_DB_4_3
5295	    softCrash("$seq->get_key needs Berkeley DB 4.3.x or better") ;
5296#else
5297        DBT_clear(key);
5298        RETVAL = seq->seq->get_key(seq->seq, &key);
5299#endif
5300    OUTPUT:
5301        RETVAL
5302        key
5303
5304DualType
5305initial_value(seq, low, high=0)
5306    BerkeleyDB::Sequence seq;
5307    int low
5308    int high
5309    PREINIT:
5310        dMY_CXT;
5311    INIT:
5312        ckActive_Sequence(seq->active) ;
5313    CODE:
5314#ifndef AT_LEAST_DB_4_3
5315	    softCrash("$seq->initial_value needs Berkeley DB 4.3.x or better") ;
5316#else
5317        RETVAL = seq->seq->initial_value(seq->seq, (db_seq_t)(high << 32 + low));
5318#endif
5319    OUTPUT:
5320        RETVAL
5321
5322DualType
5323set_cachesize(seq, size)
5324    BerkeleyDB::Sequence seq;
5325    int32_t size
5326    PREINIT:
5327        dMY_CXT;
5328    INIT:
5329        ckActive_Sequence(seq->active) ;
5330    CODE:
5331#ifndef AT_LEAST_DB_4_3
5332	    softCrash("$seq->set_cachesize needs Berkeley DB 4.3.x or better") ;
5333#else
5334        RETVAL = seq->seq->set_cachesize(seq->seq, size);
5335#endif
5336    OUTPUT:
5337        RETVAL
5338
5339DualType
5340get_cachesize(seq, size)
5341    BerkeleyDB::Sequence seq;
5342    int32_t size = NO_INIT
5343    PREINIT:
5344        dMY_CXT;
5345    INIT:
5346        ckActive_Sequence(seq->active) ;
5347    CODE:
5348#ifndef AT_LEAST_DB_4_3
5349	    softCrash("$seq->get_cachesize needs Berkeley DB 4.3.x or better") ;
5350#else
5351        RETVAL = seq->seq->get_cachesize(seq->seq, &size);
5352#endif
5353    OUTPUT:
5354        RETVAL
5355        size
5356
5357DualType
5358set_flags(seq, flags)
5359    BerkeleyDB::Sequence seq;
5360    u_int32_t flags
5361    PREINIT:
5362        dMY_CXT;
5363    INIT:
5364        ckActive_Sequence(seq->active) ;
5365    CODE:
5366#ifndef AT_LEAST_DB_4_3
5367	    softCrash("$seq->set_flags needs Berkeley DB 4.3.x or better") ;
5368#else
5369        RETVAL = seq->seq->set_flags(seq->seq, flags);
5370#endif
5371    OUTPUT:
5372        RETVAL
5373
5374DualType
5375get_flags(seq, flags)
5376    BerkeleyDB::Sequence seq;
5377    u_int32_t flags = NO_INIT
5378    PREINIT:
5379        dMY_CXT;
5380    INIT:
5381        ckActive_Sequence(seq->active) ;
5382    CODE:
5383#ifndef AT_LEAST_DB_4_3
5384	    softCrash("$seq->get_flags needs Berkeley DB 4.3.x or better") ;
5385#else
5386        RETVAL = seq->seq->get_flags(seq->seq, &flags);
5387#endif
5388    OUTPUT:
5389        RETVAL
5390        flags
5391
5392DualType
5393set_range(seq)
5394    BerkeleyDB::Sequence seq;
5395        NOT_IMPLEMENTED_YET
5396
5397DualType
5398stat(seq)
5399    BerkeleyDB::Sequence seq;
5400        NOT_IMPLEMENTED_YET
5401
5402
5403MODULE = BerkeleyDB        PACKAGE = BerkeleyDB
5404
5405BOOT:
5406  {
5407#ifdef dTHX
5408    dTHX;
5409#endif
5410    SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
5411    SV * version_sv = perl_get_sv("BerkeleyDB::db_version", GV_ADD|GV_ADDMULTI) ;
5412    SV * ver_sv = perl_get_sv("BerkeleyDB::db_ver", GV_ADD|GV_ADDMULTI) ;
5413    int Major, Minor, Patch ;
5414    MY_CXT_INIT;
5415    (void)db_version(&Major, &Minor, &Patch) ;
5416    /* Check that the versions of db.h and libdb.a are the same */
5417    if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR
5418                || Patch != DB_VERSION_PATCH)
5419        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",
5420                DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH,
5421                Major, Minor, Patch) ;
5422
5423    if (Major < 2 || (Major == 2 && Minor < 6))
5424    {
5425        croak("BerkeleyDB needs Berkeley DB 2.6 or greater. This is %d.%d.%d\n",
5426		Major, Minor, Patch) ;
5427    }
5428    sv_setpvf(version_sv, "%d.%d", Major, Minor) ;
5429    sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ;
5430    sv_setpv(sv_err, "");
5431
5432    DBT_clear(empty) ;
5433    empty.data  = &zero ;
5434    empty.size  =  sizeof(db_recno_t) ;
5435    empty.flags = 0 ;
5436
5437  }
5438
5439