/*  DB_File.xs -- Perl 5 interface to Berkeley DB  written by Paul Marquess <pmqs@cpan.org> last modified 4th February 2007 version 1.815 All comments/suggestions/problems are welcome     Copyright (c) 1995-2005 Paul Marquess. All rights reserved.     This program is free software; you can redistribute it and/or     modify it under the same terms as Perl itself. Changes:	0.1 - 	Initial Release	0.2 - 	No longer bombs out if dbopen returns an error.	0.3 - 	Added some support for multiple btree compares	1.0 - 	Complete support for multiple callbacks added.	      	Fixed a problem with pushing a value onto an empty list.	1.01 - 	Fixed a SunOS core dump problem.		The return value from TIEHASH wasn't set to NULL when		dbopen returned an error.	1.02 - 	Use ALIAS to define TIEARRAY.		Removed some redundant commented code.		Merged OS2 code into the main distribution.		Allow negative subscripts with RECNO interface.		Changed the default flags to O_CREAT|O_RDWR	1.03 - 	Added EXISTS	1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by		Dave Hammen, hammen@gothamcity.jsc.nasa.gov	1.05 -  Added logic to allow prefix & hash types to be specified via		Makefile.PL	1.06 -  Minor namespace cleanup: Localized PrintBtree.	1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n". 	1.08 -  No change to DB_File.xs	1.09 -  Default mode for dbopen changed to 0666	1.10 -  Fixed fd method so that it still returns -1 for		in-memory files when db 1.86 is used.	1.11 -  No change to DB_File.xs	1.12 -  No change to DB_File.xs	1.13 -  Tidied up a few casts.     	1.14 -	Made it illegal to tie an associative array to a RECNO		database and an ordinary array to a HASH or BTREE database.	1.50 -  Make work with both DB 1.x or DB 2.x	1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent	1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of 		undefined value" warning with db_get and db_seq.	1.53 -  Added DB_RENUMBER to flags for recno.	1.54 -  Fixed bug in the fd method        1.55 -  Fix for AIX from Jarkko Hietaniemi        1.56 -  No change to DB_File.xs        1.57 -  added the #undef op to allow building with Threads support.	1.58 -  Fixed a problem with the use of sv_setpvn. When the		size is specified as 0, it does a strlen on the data.		This was ok for DB 1.x, but isn't for DB 2.x.        1.59 -  No change to DB_File.xs        1.60 -  Some code tidy up        1.61 -  added flagSet macro for DB 2.5.x		fixed typo in O_RDONLY test.        1.62 -  No change to DB_File.xs        1.63 -  Fix to alllow DB 2.6.x to build.        1.64 -  Tidied up the 1.x to 2.x flags mapping code.		Added a patch from Mark Kettenis <kettenis@wins.uva.nl>		to fix a flag mapping problem with O_RDONLY on the Hurd        1.65 -  Fixed a bug in the PUSH logic.		Added BOOT check that using 2.3.4 or greater        1.66 -  Added DBM filter code        1.67 -  Backed off the use of newSVpvn.		Fixed DBM Filter code for Perl 5.004.		Fixed a small memory leak in the filter code.        1.68 -  fixed backward compatability bug with R_IAFTER & R_IBEFORE		merged in the 5.005_58 changes        1.69 -  fixed a bug in push -- DB_APPEND wasn't working properly.		Fixed the R_SETCURSOR bug introduced in 1.68		Added a new Perl variable $DB_File::db_ver         1.70 -  Initialise $DB_File::db_ver and $DB_File::db_version with 		GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.		Added a BOOT check to test for equivalent versions of db.h &		libdb.a/so.        1.71 -  Support for Berkeley DB version 3.		Support for Berkeley DB 2/3's backward compatability mode.		Rewrote push        1.72 -  No change to DB_File.xs        1.73 -  No change to DB_File.xs        1.74 -  A call to open needed parenthesised to stop it clashing                with a win32 macro.		Added Perl core patches 7703 & 7801.        1.75 -  Fixed Perl core patch 7703.		Added suppport to allow DB_File to be built with 		Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb		needed to be changed.        1.76 -  No change to DB_File.xs        1.77 -  Tidied up a few types used in calling newSVpvn.        1.78 -  Core patch 10335, 10372, 10534, 10549, 11051 included.        1.79 -  NEXTKEY ignores the input key.                Added lots of casts        1.800 - Moved backward compatability code into ppport.h.                Use the new constants code.        1.801 - No change to DB_File.xs        1.802 - No change to DB_File.xs        1.803 - FETCH, STORE & DELETE don't map the flags parameter                into the equivalent Berkeley DB function anymore.        1.804 - no change.        1.805 - recursion detection added to the callbacks                Support for 4.1.X added.                Filter code can now cope with read-only $_        1.806 - recursion detection beefed up.        1.807 - no change        1.808 - leak fixed in ParseOpenInfo        1.809 - no change        1.810 - no change        1.811 - no change        1.812 - no change        1.813 - no change        1.814 - no change        1.814 - C++ casting fixes*/#define PERL_NO_GET_CONTEXT#include "EXTERN.h"  #include "perl.h"#include "XSUB.h"#ifdef _NOT_CORE#  include "ppport.h"#endif/* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and   DB_VERSION_PATCH_CFG here so that Configure pulls them all in. *//* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be * shortly #included by the <db.h>) __attribute__ to the possibly * already defined __attribute__, for example by GNUC or by Perl. *//* #if DB_VERSION_MAJOR_CFG < 2  */#ifndef DB_VERSION_MAJOR#    undef __attribute__#endif#ifdef COMPAT185#    include <db_185.h>#else#    include <db.h>#endif/* Wall starts with 5.7.x */#if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)/* Since we dropped the gccish definition of __attribute__ we will want * to redefine dNOOP, however (so that dTHX continues to work).  Yes, * all this means that we can't do attribute checking on the DB_File, * boo, hiss. */#  ifndef DB_VERSION_MAJOR#    undef  dNOOP#    define dNOOP extern int Perl___notused    /* Ditto for dXSARGS. */#    undef  dXSARGS#    define dXSARGS				\	dSP; dMARK;			\	I32 ax = mark - PL_stack_base + 1;	\	I32 items = sp - mark#  endif/* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */#  undef dXSI32#  define dXSI32 dNOOP#endif /* Perl >= 5.7 */#include <fcntl.h> /* #define TRACE */#ifdef TRACE#    define Trace(x)        printf x#else#    define Trace(x)#endif#define DBT_clear(x)	Zero(&x, 1, DBT) ;#ifdef DB_VERSION_MAJOR#if DB_VERSION_MAJOR == 2#    define BERKELEY_DB_1_OR_2#endif#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)#    define AT_LEAST_DB_3_2#endif#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)#    define AT_LEAST_DB_3_3#endif#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)#    define AT_LEAST_DB_4_1#endif#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)#    define AT_LEAST_DB_4_3#endif#ifdef AT_LEAST_DB_3_3#   define WANT_ERROR#endif/* map version 2 features & constants onto their version 1 equivalent */#ifdef DB_Prefix_t#    undef DB_Prefix_t#endif#define DB_Prefix_t	size_t#ifdef DB_Hash_t#    undef DB_Hash_t#endif#define DB_Hash_t	u_int32_t/* DBTYPE stays the same *//* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */#if DB_VERSION_MAJOR == 2    typedef DB_INFO	INFO ;#else /* DB_VERSION_MAJOR > 2 */#    define DB_FIXEDLEN	(0x8000)#endif /* DB_VERSION_MAJOR == 2 *//* version 2 has db_recno_t in place of recno_t	*/typedef db_recno_t	recno_t;#define R_CURSOR        DB_SET_RANGE#define R_FIRST         DB_FIRST#define R_IAFTER        DB_AFTER#define R_IBEFORE       DB_BEFORE#define R_LAST          DB_LAST#define R_NEXT          DB_NEXT#define R_NOOVERWRITE   DB_NOOVERWRITE#define R_PREV          DB_PREV#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5#  define R_SETCURSOR	0x800000#else#  define R_SETCURSOR	(-100)#endif#define R_RECNOSYNC     0#define R_FIXEDLEN	DB_FIXEDLEN#define R_DUP		DB_DUP#define db_HA_hash 	h_hash#define db_HA_ffactor	h_ffactor#define db_HA_nelem	h_nelem#define db_HA_bsize	db_pagesize#define db_HA_cachesize	db_cachesize#define db_HA_lorder	db_lorder#define db_BT_compare	bt_compare#define db_BT_prefix	bt_prefix#define db_BT_flags	flags#define db_BT_psize	db_pagesize#define db_BT_cachesize	db_cachesize#define db_BT_lorder	db_lorder#define db_BT_maxkeypage#define db_BT_minkeypage#define db_RE_reclen	re_len#define db_RE_flags	flags#define db_RE_bval	re_pad#define db_RE_bfname	re_source#define db_RE_psize	db_pagesize#define db_RE_cachesize	db_cachesize#define db_RE_lorder	db_lorder#define TXN	NULL,#define do_SEQ(db, key, value, flag)	(db->cursor->c_get)(db->cursor, &key, &value, flag)#define DBT_flags(x)	x.flags = 0#define DB_flags(x, v)	x |= v #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5#    define flagSet(flags, bitmask)	((flags) & (bitmask))#else#    define flagSet(flags, bitmask)	(((flags) & DB_OPFLAGS_MASK) == (bitmask))#endif#else /* db version 1.x */#define BERKELEY_DB_1#define BERKELEY_DB_1_OR_2typedef union INFO {        HASHINFO 	hash ;        RECNOINFO 	recno ;        BTREEINFO 	btree ;      } INFO ;#ifdef mDB_Prefix_t #  ifdef DB_Prefix_t#    undef DB_Prefix_t#  endif#  define DB_Prefix_t	mDB_Prefix_t #endif#ifdef mDB_Hash_t#  ifdef DB_Hash_t#    undef DB_Hash_t#  endif#  define DB_Hash_t	mDB_Hash_t#endif#define db_HA_hash 	hash.hash#define db_HA_ffactor	hash.ffactor#define db_HA_nelem	hash.nelem#define db_HA_bsize	hash.bsize#define db_HA_cachesize	hash.cachesize#define db_HA_lorder	hash.lorder#define db_BT_compare	btree.compare#define db_BT_prefix	btree.prefix#define db_BT_flags	btree.flags#define db_BT_psize	btree.psize#define db_BT_cachesize	btree.cachesize#define db_BT_lorder	btree.lorder#define db_BT_maxkeypage btree.maxkeypage#define db_BT_minkeypage btree.minkeypage#define db_RE_reclen	recno.reclen#define db_RE_flags	recno.flags#define db_RE_bval	recno.bval#define db_RE_bfname	recno.bfname#define db_RE_psize	recno.psize#define db_RE_cachesize	recno.cachesize#define db_RE_lorder	recno.lorder#define TXN	#define do_SEQ(db, key, value, flag)	(db->dbp->seq)(db->dbp, &key, &value, flag)#define DBT_flags(x)	#define DB_flags(x, v)	#define flagSet(flags, bitmask)        ((flags) & (bitmask))#endif /* db version 1 */#define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, 0)#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)#define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)#define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)#define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)#ifdef DB_VERSION_MAJOR#define db_DESTROY(db)                  (!db->aborted && ( db->cursor->c_close(db->cursor),\					  (db->dbp->close)(db->dbp, 0) ))#define db_close(db)			((db->dbp)->close)(db->dbp, 0)#define db_del(db, key, flags)          (flagSet(flags, R_CURSOR) 					\						? ((db->cursor)->c_del)(db->cursor, 0)		\						: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )#else /* ! DB_VERSION_MAJOR */#define db_DESTROY(db)                  (!db->aborted && ((db->dbp)->close)(db->dbp))#define db_close(db)			((db->dbp)->close)(db->dbp)#define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)#define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)#endif /* ! DB_VERSION_MAJOR */#define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)typedef struct {	DBTYPE	type ;	DB * 	dbp ;	SV *	compare ;	bool	in_compare ;	SV *	prefix ;	bool	in_prefix ;	SV *	hash ;	bool	in_hash ;	bool	aborted ;	int	in_memory ;#ifdef BERKELEY_DB_1_OR_2	INFO 	info ;#endif	#ifdef DB_VERSION_MAJOR	DBC *	cursor ;#endif	SV *    filter_fetch_key ;	SV *    filter_store_key ;	SV *    filter_fetch_value ;	SV *    filter_store_value ;	int     filtering ;	} DB_File_type;typedef DB_File_type * DB_File ;typedef DBT DBTKEY ;#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)#define OutputValue(arg, name)  					\	{ if (RETVAL == 0) {						\	      SvGETMAGIC(arg) ;          				\	      my_sv_setpvn(arg, (const char *)name.data, name.size) ;			\	      TAINT;                                       		\	      SvTAINTED_on(arg);                                       	\	      SvUTF8_off(arg);                                       	\	      DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; 	\	  }								\	}#define OutputKey(arg, name)	 					\	{ if (RETVAL == 0) 						\	  { 								\		SvGETMAGIC(arg) ;          				\		if (db->type != DB_RECNO) {				\		    my_sv_setpvn(arg, (const char *)name.data, name.size); 		\		}							\		else 							\		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 		\	      TAINT;                                       		\	      SvTAINTED_on(arg);                                       	\	      SvUTF8_off(arg);                                       	\	      DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; 	\	  } 								\	}#define my_SvUV32(sv) ((u_int32_t)SvUV(sv))#ifdef CAN_PROTOTYPEextern void __getBerkeleyDBInfo(void);#endif/* Internal Global Data */#define MY_CXT_KEY "DB_File::_guts" XS_VERSIONtypedef struct {    recno_t	x_Value;     recno_t	x_zero;    DB_File	x_CurrentDB;    DBTKEY	x_empty;} my_cxt_t;START_MY_CXT#define Value		(MY_CXT.x_Value)#define zero		(MY_CXT.x_zero)#define CurrentDB	(MY_CXT.x_CurrentDB)#define empty		(MY_CXT.x_empty)#define ERR_BUFF "DB_File::Error"#ifdef DB_VERSION_MAJORstatic int#ifdef CAN_PROTOTYPEdb_put(DB_File db, DBTKEY key, DBT value, u_int flags)#elsedb_put(db, key, value, flags)DB_File		db ;DBTKEY		key ;DBT		value ;u_int		flags ;#endif{    int status ;    if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {        DBC * temp_cursor ;	DBT l_key, l_value;        #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6        if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)#else        if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)#endif	    return (-1) ;	memset(&l_key, 0, sizeof(l_key));	l_key.data = key.data;	l_key.size = key.size;	memset(&l_value, 0, sizeof(l_value));	l_value.data = value.data;