DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <pmqs@cpan.org>
- last modified 20th June 2004
- version 1.809
+ last modified 31st October 2005
+ version 1.813
All comments/suggestions/problems are welcome
- Copyright (c) 1995-2004 Paul Marquess. All rights reserved.
+ 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.
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
*/
# 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
#define OutputValue(arg, name) \
{ if (RETVAL == 0) { \
+ SvGETMAGIC(arg) ; \
my_sv_setpvn(arg, name.data, name.size) ; \
- TAINT; \
+ 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, name.data, name.size); \
} \
else \
sv_setiv(arg, (I32)*(I32*)name.data - 1); \
- TAINT; \
+ TAINT; \
SvTAINTED_on(arg); \
SvUTF8_off(arg); \
DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
return (retval) ;
}
-#if 0
+#ifdef WANT_ERROR
+
static void
-#ifdef CAN_PROTOTYPE
-db_errcall_cb(const char * db_errpfx, char * buffer)
+#ifdef AT_LEAST_DB_4_3
+db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
#else
-db_errcall_cb(db_errpfx, buffer)
-const char * db_errpfx;
-char * buffer;
+db_errcall_cb(const char * db_errpfx, char * buffer)
#endif
{
#ifdef dTHX
}
dbp = RETVAL->dbp ;
+#ifdef WANT_ERROR
+ RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
+#endif
if (sv)
{
if (! SvROK(sv) )
Flags |= DB_TRUNCATE ;
#endif
+#ifdef AT_LEAST_DB_4_4
+ /* need this for recno */
+ if ((flags & O_TRUNC) == O_TRUNC)
+ Flags |= DB_CREATE ;
+#endif
+
#ifdef AT_LEAST_DB_4_1
status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
Flags, mode) ;
/* printf("open returned %d %s\n", status, db_strerror(status)) ; */
if (status == 0) {
- /* RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;*/
status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
0) ;
#ifdef dTHX
dTHX;
#endif
- /* SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; */
+#ifdef WANT_ERROR
+ SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
+#endif
MY_CXT_INIT;
__getBerkeleyDBInfo() ;