db_file.xs

UNIX下perl实现代码

/* 

 DB_File.xs -- Perl 5 interface to Berkeley DB 

 written by Paul Marquess <[e-mail]>
 last modified 17 December 2000
 version 1.75

 All comments/suggestions/problems are welcome

     Copyright (c) 1995-2000 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, [e-mail]
	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 <[e-mail]> 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 <[e-mail]>
		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.

*/

#include "EXTERN.h"  
#include "perl.h"
#include "XSUB.h"

#ifndef PERL_VERSION
#    include "patchlevel.h"
#    define PERL_REVISION	5
#    define PERL_VERSION	PATCHLEVEL
#    define PERL_SUBVERSION	SUBVERSION
#endif

#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))

#    define PL_sv_undef		sv_undef
#    define PL_na		na

#endif

/* DEFSV appears first in 5.004_56 */
#ifndef DEFSV
#    define DEFSV		GvSV(defgv)
#endif

/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
 * shortly #included by the <db.h>) __attribute__ to the possibly
 * already defined __attribute__, for example by GNUC or by Perl. */

#undef __attribute__

/* If Perl has been compiled with Threads support,the symbol op will
   be defined here. This clashes with a field name in db.h, so get rid of it.
 */
#ifdef op
#    undef op
#endif

#ifdef COMPAT185
#    include <db_185.h>
#else
#    include <db.h>
#endif

#ifdef CAN_PROTOTYPE
extern void __getBerkeleyDBInfo(void);
#endif

#ifndef pTHX
#    define pTHX
#    define pTHX_
#    define aTHX
#    define aTHX_
#endif

#ifndef newSVpvn
#    define newSVpvn(a,b)	newSVpv(a,b)
#endif

#include <fcntl.h> 

/* #define TRACE */
#define DBM_FILTERING

#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

/* 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_2

typedef 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, flags)
#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, flags)
#define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)

#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->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->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 ;
	SV *	prefix ;
	SV *	hash ;
	int	in_memory ;
#ifdef BERKELEY_DB_1_OR_2
	INFO 	info ;
#endif	
#ifdef DB_VERSION_MAJOR
	DBC *	cursor ;
#endif
#ifdef DBM_FILTERING
	SV *    filter_fetch_key ;
	SV *    filter_store_key ;
	SV *    filter_fetch_value ;
	SV *    filter_store_value ;
	int     filtering ;
#endif /* DBM_FILTERING */

	} DB_File_type;

typedef DB_File_type * DB_File ;
typedef DBT DBTKEY ;

#ifdef DBM_FILTERING

#define ckFilter(arg,type,name)					\
	if (db->type) {						\
	    SV * save_defsv ;					\
            /* printf("filtering %s\n", name) ;*/		\
	    if (db->filtering)					\
	        croak("recursion detected in %s", name) ;	\
	    db->filtering = TRUE ;				\
	    save_defsv = newSVsv(DEFSV) ;			\
	    sv_setsv(DEFSV, arg) ;				\
	    PUSHMARK(sp) ;					\
	    (void) perl_call_sv(db->type, G_DISCARD|G_NOARGS); 	\
	    sv_setsv(arg, DEFSV) ;				\
	    sv_setsv(DEFSV, save_defsv) ;			\
	    SvREFCNT_dec(save_defsv) ;				\
	    db->filtering = FALSE ;				\
	    /*printf("end of filtering %s\n", name) ;*/		\
	}

#else

#define ckFilter(arg,type, name)

#endif /* DBM_FILTERING */

#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (void*)""), s)

#define OutputValue(arg, name)  					\
	{ if (RETVAL == 0) {						\
	      my_sv_setpvn(arg, name.data, name.size) ;			\
	      ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; 	\
	  }								\
	}

#define OutputKey(arg, name)	 					\
	{ if (RETVAL == 0) 						\
	  { 								\
		if (db->type != DB_RECNO) {				\
		    my_sv_setpvn(arg, name.data, name.size); 		\
		}							\
		else 							\
		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 		\
	      ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; 	\
	  } 								\
	}


/* Internal Global Data */
static recno_t Value ; 
static recno_t zero = 0 ;
static DB_File CurrentDB ;
static DBTKEY empty ;

#ifdef DB_VERSION_MAJOR

static int
#ifdef CAN_PROTOTYPE
db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
#else
db_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;
	l_value.size = value.size;

	if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
	    (void)temp_cursor->c_close(temp_cursor);
	    return (-1);
	}

	status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
	(void)temp_cursor->c_close(temp_cursor);
	    
        return (status) ;
    }	
    
    
    if (flagSet(flags, R_CURSOR)) {
	return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
    }

    if (flagSet(flags, R_SETCURSOR)) {
	if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
		return -1 ;
        return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
    
    }

    return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;

}

#endif /* DB_VERSION_MAJOR */


static int
#ifdef AT_LEAST_DB_3_2

#ifdef CAN_PROTOTYPE
btree_compare(DB * db, const DBT *key1, const DBT *key2)
#else
btree_compare(db, key1, key2)
DB * db ;
const DBT * key1 ;
const DBT * key2 ;
#endif /* CAN_PROTOTYPE */

#else /* Berkeley DB < 3.2 */

#ifdef CAN_PROTOTYPE
btree_compare(const DBT *key1, const DBT *key2)
#else
btree_compare(key1, key2)
const DBT * key1 ;
const DBT * key2 ;
#endif

#endif

{
#ifdef dTHX
    dTHX;
#endif