DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 26th April 2001
- version 1.77
+ last modified 26th Nov 2001
+ version 1.801
All comments/suggestions/problems are welcome
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
*/
+#define PERL_NO_GET_CONTEXT
#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
+#ifdef _NOT_CORE
+# include "ppport.h"
#endif
-#if PERL_REVISION == 5 && (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION <= 75 ))
+/* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
+ DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
-# define PL_sv_undef sv_undef
-# define PL_na na
+/* 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
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(defgv)
+
+
+#ifdef COMPAT185
+# include <db_185.h>
+#else
+# include <db.h>
#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. */
+/* Wall starts with 5.7.x */
-#undef __attribute__
+#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. */
-#undef dNOOP
-#define dNOOP extern int Perl___notused
-
-/* 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
+# ifndef DB_VERSION_MAJOR
-#ifdef COMPAT185
-# include <db_185.h>
-#else
-# include <db.h>
-#endif
+# undef dNOOP
+# define dNOOP extern int Perl___notused
-#ifdef CAN_PROTOTYPE
-extern void __getBerkeleyDBInfo(void);
-#endif
+ /* Ditto for dXSARGS. */
+# undef dXSARGS
+# define dXSARGS \
+ dSP; dMARK; \
+ I32 ax = mark - PL_stack_base + 1; \
+ I32 items = sp - mark
-#ifndef pTHX
-# define pTHX
-# define pTHX_
-# define aTHX
-# define aTHX_
-#endif
+# endif
-#ifndef newSVpvn
-# define newSVpvn(a,b) newSVpv(a,b)
-#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 ckFilter(arg,type,name) \
if (db->type) { \
SV * save_defsv ; \
- /* printf("filtering %s\n", name) ;*/ \
+ /* printf("filtering %s\n", name) ; */ \
if (db->filtering) \
croak("recursion detected in %s", name) ; \
db->filtering = TRUE ; \
sv_setsv(DEFSV, save_defsv) ; \
SvREFCNT_dec(save_defsv) ; \
db->filtering = FALSE ; \
- /*printf("end of filtering %s\n", name) ;*/ \
+ /* printf("end of filtering %s\n", name) ; */ \
}
#else
} \
}
+#define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
+
+#ifdef CAN_PROTOTYPE
+extern void __getBerkeleyDBInfo(void);
+#endif
/* Internal Global Data */
-static recno_t Value ;
-static recno_t zero = 0 ;
-static DB_File CurrentDB ;
-static DBTKEY empty ;
+
+#define MY_CXT_KEY "DB_File::_guts" XS_VERSION
+
+typedef 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)
#ifdef DB_VERSION_MAJOR
dTHX;
#endif
dSP ;
- char * data1, * data2 ;
+ dMY_CXT ;
+ void * data1, * data2 ;
int retval ;
int count ;
dTHX;
#endif
dSP ;
+ dMY_CXT ;
char * data1, * data2 ;
int retval ;
int count ;
dTHX;
#endif
dSP ;
+ dMY_CXT;
int retval ;
int count ;
void * openinfo = NULL ;
INFO * info = &RETVAL->info ;
STRLEN n_a;
+ dMY_CXT;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
DB * dbp ;
STRLEN n_a;
int status ;
+ dMY_CXT;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
Zero(RETVAL, 1, DB_File_type) ;
svp = hv_fetch(action, "ffactor", 7, FALSE);
if (svp)
- (void)dbp->set_h_ffactor(dbp, SvIV(*svp)) ;
+ (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
svp = hv_fetch(action, "nelem", 5, FALSE);
if (svp)
- (void)dbp->set_h_nelem(dbp, SvIV(*svp)) ;
+ (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
svp = hv_fetch(action, "bsize", 5, FALSE);
if (svp)
- (void)dbp->set_pagesize(dbp, SvIV(*svp));
+ (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
svp = hv_fetch(action, "cachesize", 9, FALSE);
if (svp)
- (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+ (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
svp = hv_fetch(action, "lorder", 6, FALSE);
if (svp)
- (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
+ (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
PrintHash(info) ;
}
svp = hv_fetch(action, "flags", 5, FALSE);
if (svp)
- (void)dbp->set_flags(dbp, SvIV(*svp)) ;
+ (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
svp = hv_fetch(action, "cachesize", 9, FALSE);
if (svp)
- (void)dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+ (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
svp = hv_fetch(action, "psize", 5, FALSE);
if (svp)
- (void)dbp->set_pagesize(dbp, SvIV(*svp)) ;
+ (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
svp = hv_fetch(action, "lorder", 6, FALSE);
if (svp)
- (void)dbp->set_lorder(dbp, SvIV(*svp)) ;
+ (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
PrintBtree(info) ;
svp = hv_fetch(action, "cachesize", 9, FALSE);
if (svp) {
- status = dbp->set_cachesize(dbp, 0, SvIV(*svp), 0) ;
+ status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
}
svp = hv_fetch(action, "psize", 5, FALSE);
if (svp) {
- status = dbp->set_pagesize(dbp, SvIV(*svp)) ;
+ status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
}
svp = hv_fetch(action, "lorder", 6, FALSE);
if (svp) {
- status = dbp->set_lorder(dbp, SvIV(*svp)) ;
+ status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
}
svp = hv_fetch(action, "bval", 4, FALSE);
if (SvPOK(*svp))
value = (int)*SvPV(*svp, n_a) ;
else
- value = SvIV(*svp) ;
+ value = (int)SvIV(*svp) ;
if (fixed) {
status = dbp->set_re_pad(dbp, value) ;
if (fixed) {
svp = hv_fetch(action, "reclen", 6, FALSE);
if (svp) {
- u_int32_t len = (u_int32_t)SvIV(*svp) ;
+ u_int32_t len = my_SvUV32(*svp) ;
status = dbp->set_re_len(dbp, len) ;
}
}
name = NULL ;
- status = dbp->set_flags(dbp, DB_RENUMBER) ;
+ status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
if (flags){
- (void)dbp->set_flags(dbp, flags) ;
+ (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
}
PrintRecno(info) ;
}
}
{
- int Flags = 0 ;
+ u_int32_t Flags = 0 ;
int status ;
/* Map 1.x flags to 3.x flags */
} /* ParseOpenInfo */
-static double
-#ifdef CAN_PROTOTYPE
-constant(char *name, int arg)
-#else
-constant(name, arg)
-char *name;
-int arg;
-#endif
-{
- errno = 0;
- switch (*name) {
- case 'A':
- break;
- case 'B':
- if (strEQ(name, "BTREEMAGIC"))
-#ifdef BTREEMAGIC
- return BTREEMAGIC;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "BTREEVERSION"))
-#ifdef BTREEVERSION
- return BTREEVERSION;
-#else
- goto not_there;
-#endif
- break;
- case 'C':
- break;
- case 'D':
- if (strEQ(name, "DB_LOCK"))
-#ifdef DB_LOCK
- return DB_LOCK;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "DB_SHMEM"))
-#ifdef DB_SHMEM
- return DB_SHMEM;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "DB_TXN"))
-#ifdef DB_TXN
- return (U32)DB_TXN;
-#else
- goto not_there;
-#endif
- break;
- case 'E':
- break;
- case 'F':
- break;
- case 'G':
- break;
- case 'H':
- if (strEQ(name, "HASHMAGIC"))
-#ifdef HASHMAGIC
- return HASHMAGIC;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "HASHVERSION"))
-#ifdef HASHVERSION
- return HASHVERSION;
-#else
- goto not_there;
-#endif
- break;
- case 'I':
- break;
- case 'J':
- break;
- case 'K':
- break;
- case 'L':
- break;
- case 'M':
- if (strEQ(name, "MAX_PAGE_NUMBER"))
-#ifdef MAX_PAGE_NUMBER
- return (U32)MAX_PAGE_NUMBER;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "MAX_PAGE_OFFSET"))
-#ifdef MAX_PAGE_OFFSET
- return MAX_PAGE_OFFSET;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "MAX_REC_NUMBER"))
-#ifdef MAX_REC_NUMBER
- return (U32)MAX_REC_NUMBER;
-#else
- goto not_there;
-#endif
- break;
- case 'N':
- break;
- case 'O':
- break;
- case 'P':
- break;
- case 'Q':
- break;
- case 'R':
- if (strEQ(name, "RET_ERROR"))
-#ifdef RET_ERROR
- return RET_ERROR;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "RET_SPECIAL"))
-#ifdef RET_SPECIAL
- return RET_SPECIAL;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "RET_SUCCESS"))
-#ifdef RET_SUCCESS
- return RET_SUCCESS;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_CURSOR"))
-#ifdef R_CURSOR
- return R_CURSOR;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_DUP"))
-#ifdef R_DUP
- return R_DUP;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_FIRST"))
-#ifdef R_FIRST
- return R_FIRST;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_FIXEDLEN"))
-#ifdef R_FIXEDLEN
- return R_FIXEDLEN;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_IAFTER"))
-#ifdef R_IAFTER
- return R_IAFTER;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_IBEFORE"))
-#ifdef R_IBEFORE
- return R_IBEFORE;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_LAST"))
-#ifdef R_LAST
- return R_LAST;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_NEXT"))
-#ifdef R_NEXT
- return R_NEXT;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_NOKEY"))
-#ifdef R_NOKEY
- return R_NOKEY;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_NOOVERWRITE"))
-#ifdef R_NOOVERWRITE
- return R_NOOVERWRITE;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_PREV"))
-#ifdef R_PREV
- return R_PREV;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_RECNOSYNC"))
-#ifdef R_RECNOSYNC
- return R_RECNOSYNC;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_SETCURSOR"))
-#ifdef R_SETCURSOR
- return R_SETCURSOR;
-#else
- goto not_there;
-#endif
- if (strEQ(name, "R_SNAPSHOT"))
-#ifdef R_SNAPSHOT
- return R_SNAPSHOT;
-#else
- goto not_there;
-#endif
- break;
- case 'S':
- break;
- case 'T':
- break;
- case 'U':
- break;
- case 'V':
- break;
- case 'W':
- break;
- case 'X':
- break;
- case 'Y':
- break;
- case 'Z':
- break;
- case '_':
- break;
- }
- errno = EINVAL;
- return 0;
-
-not_there:
- errno = ENOENT;
- return 0;
-}
+#include "constants.h"
MODULE = DB_File PACKAGE = DB_File PREFIX = db_
+INCLUDE: constants.xs
+
BOOT:
{
+ MY_CXT_INIT;
__getBerkeleyDBInfo() ;
DBT_clear(empty) ;
empty.size = sizeof(recno_t) ;
}
-double
-constant(name,arg)
- char * name
- int arg
DB_File
int
db_DESTROY(db)
DB_File db
+ PREINIT:
+ dMY_CXT;
INIT:
CurrentDB = db ;
CLEANUP:
DB_File db
DBTKEY key
u_int flags
+ PREINIT:
+ dMY_CXT;
INIT:
CurrentDB = db ;
db_EXISTS(db, key)
DB_File db
DBTKEY key
+ PREINIT:
+ dMY_CXT;
CODE:
{
DBT value ;
OUTPUT:
RETVAL
-int
+void
db_FETCH(db, key, flags=0)
DB_File db
DBTKEY key
u_int flags
+ PREINIT:
+ dMY_CXT ;
+ int RETVAL ;
CODE:
{
DBT value ;
DBTKEY key
DBT value
u_int flags
+ PREINIT:
+ dMY_CXT;
INIT:
CurrentDB = db ;
-int
+void
db_FIRSTKEY(db)
DB_File db
+ PREINIT:
+ dMY_CXT ;
+ int RETVAL ;
CODE:
{
DBTKEY key ;
OutputKey(ST(0), key) ;
}
-int
+void
db_NEXTKEY(db, key)
DB_File db
- DBTKEY key
+ DBTKEY key = NO_INIT
+ PREINIT:
+ dMY_CXT ;
+ int RETVAL ;
CODE:
{
DBT value ;
+ DBT_clear(key) ;
DBT_clear(value) ;
CurrentDB = db ;
RETVAL = do_SEQ(db, key, value, R_NEXT) ;
unshift(db, ...)
DB_File db
ALIAS: UNSHIFT = 1
+ PREINIT:
+ dMY_CXT;
CODE:
{
DBTKEY key ;
OUTPUT:
RETVAL
-I32
+void
pop(db)
DB_File db
+ PREINIT:
+ dMY_CXT;
ALIAS: POP = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBTKEY key ;
}
}
-I32
+void
shift(db)
DB_File db
+ PREINIT:
+ dMY_CXT;
ALIAS: SHIFT = 1
+ PREINIT:
+ I32 RETVAL;
CODE:
{
DBT value ;
I32
push(db, ...)
DB_File db
+ PREINIT:
+ dMY_CXT;
ALIAS: PUSH = 1
CODE:
{
I32
length(db)
DB_File db
+ PREINIT:
+ dMY_CXT;
ALIAS: FETCHSIZE = 1
CODE:
CurrentDB = db ;
DB_File db
DBTKEY key
u_int flags
+ PREINIT:
+ dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_del(db, key, flags) ;
DBTKEY key
DBT value = NO_INIT
u_int flags
+ PREINIT:
+ dMY_CXT;
CODE:
CurrentDB = db ;
DBT_clear(value) ;
DBTKEY key
DBT value
u_int flags
+ PREINIT:
+ dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_put(db, key, value, flags) ;
int
db_fd(db)
DB_File db
- int status = 0 ;
+ PREINIT:
+ dMY_CXT ;
CODE:
CurrentDB = db ;
#ifdef DB_VERSION_MAJOR
RETVAL = -1 ;
- status = (db->in_memory
- ? -1
- : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
- if (status != 0)
- RETVAL = -1 ;
+ {
+ int status = 0 ;
+ status = (db->in_memory
+ ? -1
+ : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
+ if (status != 0)
+ RETVAL = -1 ;
+ }
#else
RETVAL = (db->in_memory
? -1
db_sync(db, flags=0)
DB_File db
u_int flags
+ PREINIT:
+ dMY_CXT;
CODE:
CurrentDB = db ;
RETVAL = db_sync(db, flags) ;
DBTKEY key
DBT value = NO_INIT
u_int flags
+ PREINIT:
+ dMY_CXT;
CODE:
CurrentDB = db ;
DBT_clear(value) ;
projects / p5sagit/p5-mst-13.2.git / blobdiff