#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <gdbm.h>
#include <fcntl.h>
#define fetch_key 0
#define store_key 1
#define fetch_value 2
#define store_value 3
typedef struct {
GDBM_FILE dbp ;
SV * filter[4];
int filtering ;
} GDBM_File_type;
typedef GDBM_File_type * GDBM_File ;
typedef datum datum_key ;
typedef datum datum_value ;
typedef datum datum_key_copy;
/* Indexes for gdbm_flags aliases */
enum {
opt_flags = 0,
opt_cache_size,
opt_sync_mode,
opt_centfree,
opt_coalesce,
opt_dbname,
opt_block_size,
opt_mmap,
opt_mmapsize
};
/* Names of gdbm_flags aliases, for error reporting.
Indexed by opt_ constants above.
*/
char const *opt_names[] = {
"GDBM_File::flags",
"GDBM_File::cache_size",
"GDBM_File::sync_mode",
"GDBM_File::centfree",
"GDBM_File::coalesce",
"GDBM_File::dbname",
"GDBM_File::block_size",
"GDBM_File::mmap",
"GDBM_File::mmapsize"
};
#ifdef GDBM_VERSION_MAJOR
# define GDBM_VERSION_GUESS 0
#else
/* Try educated guess
* The value of GDBM_VERSION_GUESS indicates how rough the guess is:
* 1 - Precise; based on the CVS logs and existing archives
* 2 - Moderate. The major and minor number are correct. The patchlevel
* is set to the upper bound.
* 3 - Rough; The version is guaranteed to be not newer than major.minor.
*/
# if defined(GDBM_SYNCMODE)
/* CHANGES from 1.7.3 to 1.8
* 1. Added GDBM_CENTFREE functionality and option.
*/
# define GDBM_VERSION_MAJOR 1
# define GDBM_VERSION_MINOR 8
# define GDBM_VERSION_PATCH 3
# define GDBM_VERSION_GUESS 1
# elif defined(GDBM_FASTMODE)
/* CHANGES from 1.7.2 to 1.7.3
* 1. Fixed a couple of last minute problems. (Namely, no autoconf.h in
* version.c, and no GDBM_FASTMODE in gdbm.h!)
*/
# define GDBM_VERSION_MAJOR 1
# define GDBM_VERSION_MINOR 7
# define GDBM_VERSION_PATCH 3
# define GDBM_VERSION_GUESS 1
# elif defined(GDBM_FAST)
/* From CVS logs:
* Mon May 17 12:32:02 1993 Phil Nelson (phil at cs.wwu.edu)
*
* * gdbm.proto: Added GDBM_FAST to the read_write flags.
*/
# define GDBM_VERSION_MAJOR 1
# define GDBM_VERSION_MINOR 7
# define GDBM_VERSION_PATCH 2
# define GDBM_VERSION_GUESS 2
# else
# define GDBM_VERSION_MAJOR 1
# define GDBM_VERSION_MINOR 6
# define GDBM_VERSION_GUESS 3
# endif
#endif
#ifndef GDBM_VERSION_PATCH
# define GDBM_VERSION_PATCH 0
#endif
/* The use of fatal_func argument to gdbm_open is deprecated since 1.13 */
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
# define FATALFUNC NULL
#elif GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9
# define FATALFUNC croak_string
# define NEED_FATALFUNC 1
#else
# define FATALFUNC (void (*)()) croak_string
# define NEED_FATALFUNC 1
#endif
#ifdef NEED_FATALFUNC
static void
croak_string(const char *message) {
Perl_croak_nocontext("%s", message);
}
#endif
#define not_here(s) (croak("GDBM_File::%s not implemented", #s),-1)
#if ! (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11)
typedef unsigned gdbm_count_t;
#endif
/* GDBM allocates the datum with system malloc() and expects the user
* to free() it. So we either have to free() it immediately, or have
* perl free() it when it deallocates the SV, depending on whether
* perl uses malloc()/free() or not. */
static void
output_datum(pTHX_ SV *arg, char *str, int size)
{
sv_setpvn(arg, str, size);
# undef free
free(str);
}
/* Versions of gdbm prior to 1.7x might not have the gdbm_sync,
gdbm_exists, and gdbm_setopt functions. Apparently Slackware
(Linux) 2.1 contains gdbm-1.5 (which dates back to 1991).
*/
#ifndef GDBM_FAST
#define gdbm_exists(db,key) not_here("gdbm_exists")
#define gdbm_sync(db) (void) not_here("gdbm_sync")
#define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt")
#endif
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13
/* Prior to 1.13, only gdbm_fetch set GDBM_ITEM_NOT_FOUND if the requested
key did not exist. Other similar functions would set GDBM_NO_ERROR instead.
The GDBM_ITEM_NOT_FOUND existed as early as in 1.7.3 */
# define ITEM_NOT_FOUND() (gdbm_errno == GDBM_NO_ERROR || gdbm_errno == GDBM_ITEM_NOT_FOUND)
#else
# define ITEM_NOT_FOUND() (gdbm_errno == GDBM_ITEM_NOT_FOUND)
#endif
#define CHECKDB(db) do { \
if (!db->dbp) { \
croak("database was closed"); \
} \
} while (0)
static void
dbcroak(GDBM_File db, char const *func)
{
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
if (db)
croak("%s: %s", func, gdbm_db_strerror(db->dbp));
if (gdbm_check_syserr(gdbm_errno))
croak("%s: %s: %s", func, gdbm_strerror(gdbm_errno), strerror(errno));
#else
(void)db;
#endif
croak("%s: %s", func, gdbm_strerror(gdbm_errno));
}
#if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90)
# define gdbm_close(db) gdbm_close(db->dbp)
#else
# define gdbm_close(db) (gdbm_close(db->dbp),0)
#endif
static int
gdbm_file_close(GDBM_File db)
{
int rc = 0;
if (db->dbp) {
rc = gdbm_close(db);
db->dbp = NULL;
}
return rc;
}
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
/* Error-reporting wrapper for gdbm_recover */
static void
rcvr_errfun(void *cv, char const *fmt, ...)
{
dTHX;
dSP;
va_list ap;
ENTER;
SAVETMPS;
PUSHMARK(SP);
va_start(ap, fmt);
XPUSHs(sv_2mortal(vnewSVpvf(fmt, &ap)));
va_end(ap);
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
FREETMPS;
LEAVE;
}
#endif
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR < 13
static int
gdbm_check_syserr(int ec)
{
switch (ec) {
case GDBM_FILE_OPEN_ERROR:
case GDBM_FILE_WRITE_ERROR:
case GDBM_FILE_SEEK_ERROR:
case GDBM_FILE_READ_ERROR:
return 1;
default:
return 0;
}
}
#endif
static I32
get_gdbm_errno(pTHX_ IV idx, SV *sv)
{
PERL_UNUSED_ARG(idx);
sv_setiv(sv, gdbm_errno);
sv_setpv(sv, gdbm_strerror(gdbm_errno));
if (gdbm_check_syserr(gdbm_errno)) {
SV *val = get_sv("!", 0);
if (val) {
sv_catpv(sv, ": ");
sv_catsv(sv, val);
}
}
SvIOK_on(sv);
return 0;
}
static I32
set_gdbm_errno(pTHX_ IV idx, SV *sv)
{
PERL_UNUSED_ARG(idx);
gdbm_errno = SvIV(sv);
return 0;
}
#include "const-c.inc"
MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_
INCLUDE: const-xs.inc
BOOT:
{
SV *sv = get_sv("GDBM_File::gdbm_errno", GV_ADD);
struct ufuncs uf;
uf.uf_val = get_gdbm_errno;
uf.uf_set = set_gdbm_errno;
uf.uf_index = 0;
sv_magic(sv, NULL, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf));
}
void
gdbm_GDBM_version(package)
PPCODE:
I32 gimme = GIMME_V;
if (gimme == G_VOID) {
/* nothing */;
} else if (gimme == G_SCALAR) {
static char const *guess[] = {
"",
" (exact guess)",
" (approximate)",
" (rough guess)"
};
if (GDBM_VERSION_PATCH > 0) {
XPUSHs(sv_2mortal(newSVpvf("%d.%d.%d%s",
GDBM_VERSION_MAJOR,
GDBM_VERSION_MINOR,
GDBM_VERSION_PATCH,
guess[GDBM_VERSION_GUESS])));
} else {
XPUSHs(sv_2mortal(newSVpvf("%d.%d%s",
GDBM_VERSION_MAJOR,
GDBM_VERSION_MINOR,
guess[GDBM_VERSION_GUESS])));
}
} else {
XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MAJOR)));
XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MINOR)));
XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_PATCH)));
if (GDBM_VERSION_GUESS > 0) {
XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_GUESS)));
}
}
GDBM_File
gdbm_TIEHASH(dbtype, name, read_write, mode)
char * dbtype
char * name
int read_write
int mode
PREINIT:
GDBM_FILE dbp;
CODE:
dbp = gdbm_open(name, 0, read_write, mode, FATALFUNC);
if (!dbp && gdbm_errno == GDBM_BLOCK_SIZE_ERROR) {
/*
* By specifying a block size of 0 above, we asked gdbm to
* default to the filesystem's block size. That's usually the
* right size to choose. But some versions of gdbm require
* a power-of-two block size, and some unusual filesystems
* or devices have a non-power-of-two size that cause this
* defaulting to fail. In that case, force an acceptable
* block size.
*/
dbp = gdbm_open(name, 4096, read_write, mode, FATALFUNC);
}
if (dbp) {
RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type));
RETVAL->dbp = dbp;
} else {
RETVAL = NULL;
}
OUTPUT:
RETVAL
void
gdbm_DESTROY(db)
GDBM_File db
PREINIT:
int i = store_value;
CODE:
if (gdbm_file_close(db)) {
croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno),
strerror(errno));
}
do {
if (db->filter[i])
SvREFCNT_dec(db->filter[i]);
} while (i-- > 0);
safefree(db);
void
gdbm_UNTIE(db, count)
GDBM_File db
unsigned count
CODE:
if (count == 0) {
if (gdbm_file_close(db))
croak("gdbm_close: %s; %s",
gdbm_strerror(gdbm_errno),
strerror(errno));
}
#define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key)
datum_value
gdbm_FETCH(db, key)
GDBM_File db
datum_key_copy key
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
dbcroak(db, "gdbm_fetch");
}
#define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags)
int
gdbm_STORE(db, key, value, flags = GDBM_REPLACE)
GDBM_File db
datum_key key
datum_value value
int flags
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL) {
dbcroak(db, "gdbm_store");
}
#define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key)
int
gdbm_DELETE(db, key)
GDBM_File db
datum_key key
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL && !ITEM_NOT_FOUND()) {
dbcroak(db, "gdbm_delete");
}
#define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp)
datum_key
gdbm_FIRSTKEY(db)
GDBM_File db
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
dbcroak(db, "gdbm_firstkey");
}
#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key)
datum_key
gdbm_NEXTKEY(db, key)
GDBM_File db
datum_key key
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) {
dbcroak(db, "gdbm_nextkey");
}
#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key)
int
gdbm_EXISTS(db, key)
GDBM_File db
datum_key key
INIT:
CHECKDB(db);
##
int
gdbm_close(db)
GDBM_File db
INIT:
CHECKDB(db);
CODE:
RETVAL = gdbm_file_close(db);
OUTPUT:
RETVAL
#define gdbm_gdbm_check_syserr(ec) gdbm_check_syserr(ec)
int
gdbm_gdbm_check_syserr(ec)
int ec
SV *
gdbm_errno(db)
GDBM_File db
INIT:
CHECKDB(db);
CODE:
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
{
int ec = gdbm_last_errno(db->dbp);
RETVAL = newSViv(ec);
sv_setpv(RETVAL, gdbm_db_strerror (db->dbp));
SvIOK_on(RETVAL);
}
#else
RETVAL = newSVsv(get_sv("GDBM_File::gdbm_errno", 0));
#endif
OUTPUT:
RETVAL
int
gdbm_syserrno(db)
GDBM_File db
INIT:
CHECKDB(db);
CODE:
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
{
int ec = gdbm_last_errno(db->dbp);
if (gdbm_check_syserr(ec)) {
RETVAL = gdbm_last_syserr(db->dbp);
} else {
RETVAL = 0;
}
}
#else
RETVAL = not_here("syserrno");
#endif
OUTPUT:
RETVAL
SV *
gdbm_strerror(db)
GDBM_File db
PREINIT:
char const *errstr;
INIT:
CHECKDB(db);
CODE:
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
errstr = gdbm_db_strerror(db->dbp);
#else
errstr = gdbm_strerror(gdbm_errno);
#endif
RETVAL = newSVpv(errstr, 0);
OUTPUT:
RETVAL
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
# define gdbm_clear_error(db) gdbm_clear_error(db->dbp)
#else
# define gdbm_clear_error(db) (gdbm_errno = 0)
#endif
void
gdbm_clear_error(db)
GDBM_File db
INIT:
CHECKDB(db);
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
# define gdbm_needs_recovery(db) gdbm_needs_recovery(db->dbp)
#else
# define gdbm_needs_recovery(db) not_here("gdbm_needs_recovery")
#endif
int
gdbm_needs_recovery(db)
GDBM_File db
INIT:
CHECKDB(db);
#define gdbm_reorganize(db) gdbm_reorganize(db->dbp)
int
gdbm_reorganize(db)
GDBM_File db
INIT:
CHECKDB(db);
# Arguments:
# err => sub { ... }
# max_failed_keys => $n
# max_failed_buckets => $n
# max_failures => $n
# backup => \$str
# stat => \%hash
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
void
gdbm_recover(db, ...)
GDBM_File db
PREINIT:
int flags = GDBM_RCVR_FORCE;
SV *backup_ref = &PL_sv_undef;
SV *stat_ref = &PL_sv_undef;
gdbm_recovery rcvr;
INIT:
CHECKDB(db);
CODE:
if (items > 1) {
int i;
if ((items % 2) == 0) {
croak_xs_usage(cv, "db, %opts");
}
for (i = 1; i < items; i += 2) {
char *kw;
SV *sv = ST(i);
SV *val = ST(i+1);
kw = SvPV_nolen(sv);
if (strcmp(kw, "err") == 0) {
SvGETMAGIC(val);
if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV) {
rcvr.data = SvRV(val);
} else {
croak("%s must be a code ref", kw);
}
rcvr.errfun = rcvr_errfun;
flags |= GDBM_RCVR_ERRFUN;
} else if (strcmp(kw, "max_failed_keys") == 0) {
rcvr.max_failed_keys = SvUV(val);
flags |= GDBM_RCVR_MAX_FAILED_KEYS;
} else if (strcmp(kw, "max_failed_buckets") == 0) {
rcvr.max_failed_buckets = SvUV(val);
flags |= GDBM_RCVR_MAX_FAILED_BUCKETS;
} else if (strcmp(kw, "max_failures") == 0) {
rcvr.max_failures = SvUV(val);
flags |= GDBM_RCVR_MAX_FAILURES;
} else if (strcmp(kw, "backup") == 0) {
SvGETMAGIC(val);
if (SvROK(val) && SvTYPE(SvRV(val)) < SVt_PVAV) {
backup_ref = val;
} else {
croak("%s must be a scalar reference", kw);
}
flags |= GDBM_RCVR_BACKUP;
} else if (strcmp(kw, "stat") == 0) {
SvGETMAGIC(val);
if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) {
stat_ref = val;
} else {
croak("%s must be a scalar reference", kw);
}
} else {
croak("%s: unrecognized argument", kw);
}
}
}
if (gdbm_recover(db->dbp, &rcvr, flags)) {
dbcroak(db, "gdbm_recover");
}
if (stat_ref != &PL_sv_undef) {
HV *hv = (HV*)SvRV(stat_ref);
#define STAT_RECOVERED_KEYS_STR "recovered_keys"
#define STAT_RECOVERED_KEYS_LEN (sizeof(STAT_RECOVERED_KEYS_STR)-1)
#define STAT_RECOVERED_BUCKETS_STR "recovered_buckets"
#define STAT_RECOVERED_BUCKETS_LEN (sizeof(STAT_RECOVERED_BUCKETS_STR)-1)
#define STAT_FAILED_KEYS_STR "failed_keys"
#define STAT_FAILED_KEYS_LEN (sizeof(STAT_FAILED_KEYS_STR)-1)
#define STAT_FAILED_BUCKETS_STR "failed_buckets"
#define STAT_FAILED_BUCKETS_LEN (sizeof(STAT_FAILED_BUCKETS_STR)-1)
hv_store(hv, STAT_RECOVERED_KEYS_STR, STAT_RECOVERED_KEYS_LEN,
newSVuv(rcvr.recovered_keys), 0);
hv_store(hv,
STAT_RECOVERED_BUCKETS_STR,
STAT_RECOVERED_BUCKETS_LEN,
newSVuv(rcvr.recovered_buckets), 0);
hv_store(hv,
STAT_FAILED_KEYS_STR,
STAT_FAILED_KEYS_LEN,
newSVuv(rcvr.failed_keys), 0);
hv_store(hv,
STAT_FAILED_BUCKETS_STR,
STAT_FAILED_BUCKETS_LEN,
newSVuv(rcvr.failed_buckets), 0);
}
if (backup_ref != &PL_sv_undef) {
SV *sv = SvRV(backup_ref);
sv_setpv(sv, rcvr.backup_name);
free(rcvr.backup_name);
}
#endif
#if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90)
# define gdbm_sync(db) gdbm_sync(db->dbp)
#else
# define gdbm_sync(db) (gdbm_sync(db->dbp),0)
#endif
int
gdbm_sync(db)
GDBM_File db
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL) {
dbcroak(db, "gdbm_sync");
}
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11
gdbm_count_t
gdbm_count(db)
GDBM_File db
PREINIT:
gdbm_count_t c;
INIT:
CHECKDB(db);
CODE:
if (gdbm_count(db->dbp, &c)) {
dbcroak(db, "gdbm_count");
}
RETVAL = c;
OUTPUT:
RETVAL
void
gdbm_dump(db, filename, ...)
GDBM_File db
char * filename
PREINIT:
int format = GDBM_DUMP_FMT_ASCII;
int flags = GDBM_WRCREAT;
int mode = 0666;
INIT:
CHECKDB(db);
CODE:
if (items % 2) {
croak_xs_usage(cv, "db, filename, %opts");
} else {
int i;
for (i = 2; i < items; i += 2) {
char *kw;
SV *sv = ST(i);
SV *val = ST(i+1);
kw = SvPV_nolen(sv);
if (strcmp(kw, "mode") == 0) {
mode = SvUV(val) & 0777;
} else if (strcmp(kw, "binary") == 0) {
if (SvTRUE(val)) {
format = GDBM_DUMP_FMT_BINARY;
}
} else if (strcmp(kw, "overwrite") == 0) {
if (SvTRUE(val)) {
flags = GDBM_NEWDB;
}
} else {
croak("unrecognized keyword: %s", kw);
}
}
if (gdbm_dump(db->dbp, filename, format, flags, mode)) {
dbcroak(NULL, "dump");
}
}
void
gdbm_load(db, filename, ...)
GDBM_File db
char * filename
PREINIT:
int flag = GDBM_INSERT;
int meta_mask = 0;
unsigned long errline;
int result;
int strict_errors = 0;
INIT:
CHECKDB(db);
CODE:
if (items % 2) {
croak_xs_usage(cv, "db, filename, %opts");
} else {
int i;
for (i = 2; i < items; i += 2) {
char *kw;
SV *sv = ST(i);
SV *val = ST(i+1);
kw = SvPV_nolen(sv);
if (strcmp(kw, "restore_mode") == 0) {
if (!SvTRUE(val))
meta_mask |= GDBM_META_MASK_MODE;
} else if (strcmp(kw, "restore_owner") == 0) {
if (!SvTRUE(val))
meta_mask |= GDBM_META_MASK_OWNER;
} else if (strcmp(kw, "replace") == 0) {
if (SvTRUE(val))
flag = GDBM_REPLACE;
} else if (strcmp(kw, "strict_errors") == 0) {
strict_errors = SvTRUE(val);
} else {
croak("unrecognized keyword: %s", kw);
}
}
}
result = gdbm_load(&db->dbp, filename, flag, meta_mask, &errline);
if (result == -1 || (result == 1 && strict_errors)) {
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13
if (errline) {
croak("%s:%lu: database load error: %s",
filename, errline, gdbm_db_strerror(db->dbp));
} else {
croak("%s: database load error: %s",
filename, gdbm_db_strerror(db->dbp));
}
#else
if (errline) {
croak("%s:%lu: database load error: %s",
filename, errline, gdbm_strerror(gdbm_errno));
} else {
croak("%s: database load error: %s",
filename, gdbm_strerror(gdbm_errno));
}
#endif
}
#endif
#define OPTNAME(a,b) a ## b
#define INTOPTSETUP(opt) \
do { \
if (items == 1) { \
opcode = OPTNAME(GDBM_GET, opt); \
} else { \
opcode = OPTNAME(GDBM_SET, opt); \
c_iv = SvIV(ST(1)); \
} \
} while (0)
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9
# define OPTVALPTR void *
#else
# define OPTVALPTR int *
#endif
# GDBM_GET defines appeared in version 1.9 (2011-08-12).
#
# Provide definitions for earlier versions. These will cause gdbm_setopt
# to fail with GDBM_OPT_ILLEGAL
#ifndef GDBM_GETFLAGS
# define GDBM_GETFLAGS -1
#endif
#ifndef GDBM_GETMMAP
# define GDBM_GETMMAP -1
#endif
#ifndef GDBM_GETCACHESIZE
# define GDBM_GETCACHESIZE -1
#endif
#ifndef GDBM_GETSYNCMODE
# define GDBM_GETSYNCMODE -1
#endif
#ifndef GDBM_GETCENTFREE
# define GDBM_GETCENTFREE -1
#endif
#ifndef GDBM_GETCOALESCEBLKS
# define GDBM_GETCOALESCEBLKS -1
#endif
#ifndef GDBM_GETMAXMAPSIZE
# define GDBM_GETMAXMAPSIZE -1
#endif
#ifndef GDBM_GETDBNAME
# define GDBM_GETDBNAME -1
#endif
#ifndef GDBM_GETBLOCKSIZE
# define GDBM_GETBLOCKSIZE -1
#endif
# These two appeared in version 1.10:
#ifndef GDBM_SETMAXMAPSIZE
# define GDBM_SETMAXMAPSIZE -1
#endif
#ifndef GDBM_SETMMAP
# define GDBM_SETMMAP -1
#endif
# These GDBM_SET defines appeared in 1.10, replacing obsolete opcodes.
# Provide definitions for older versions
#ifndef GDBM_SETCACHESIZE
# define GDBM_SETCACHESIZE GDBM_CACHESIZE
#endif
#ifndef GDBM_SETSYNCMODE
# define GDBM_SETSYNCMODE GDBM_SYNCMODE
#endif
#ifndef GDBM_SETCENTFREE
# define GDBM_SETCENTFREE GDBM_CENTFREE
#endif
#ifndef GDBM_SETCOALESCEBLKS
# define GDBM_SETCOALESCEBLKS GDBM_COALESCEBLKS
#endif
SV *
gdbm_flags(db, ...)
GDBM_File db
SV * RETVAL = &PL_sv_undef;
ALIAS:
GDBM_File::cache_size = opt_cache_size
GDBM_File::sync_mode = opt_sync_mode
GDBM_File::centfree = opt_centfree
GDBM_File::coalesce = opt_coalesce
GDBM_File::dbname = opt_dbname
GDBM_File::block_size = opt_block_size
GDBM_File::mmap = opt_mmap
GDBM_File::mmapsize = opt_mmapsize
PREINIT:
int opcode = -1;
int c_iv;
size_t c_uv;
char *c_cv;
OPTVALPTR vptr = (OPTVALPTR) &c_iv;
size_t vsiz = sizeof(c_iv);
INIT:
CHECKDB(db);
CODE:
if (items > 2) {
croak("%s: too many arguments", opt_names[ix]);
}
switch (ix) {
case opt_flags:
if (items > 1) {
croak("%s: too many arguments", opt_names[ix]);
}
opcode = GDBM_GETFLAGS;
break;
case opt_cache_size:
INTOPTSETUP(CACHESIZE);
break;
case opt_sync_mode:
INTOPTSETUP(SYNCMODE);
break;
case opt_centfree:
INTOPTSETUP(CENTFREE);
break;
case opt_coalesce:
INTOPTSETUP(COALESCEBLKS);
break;
case opt_dbname:
if (items > 1) {
croak("%s: too many arguments", opt_names[ix]);
}
opcode = GDBM_GETDBNAME;
vptr = (OPTVALPTR) &c_cv;
vsiz = sizeof(c_cv);
break;
case opt_block_size:
if (items > 1) {
croak("%s: too many arguments", opt_names[ix]);
}
opcode = GDBM_GETBLOCKSIZE;
break;
case opt_mmap:
if (items > 1) {
croak("%s: too many arguments", opt_names[ix]);
}
opcode = GDBM_GETMMAP;
break;
case opt_mmapsize:
vptr = (OPTVALPTR) &c_uv;
vsiz = sizeof(c_uv);
if (items == 1) {
opcode = GDBM_GETMAXMAPSIZE;
} else {
opcode = GDBM_SETMAXMAPSIZE;
c_uv = SvUV(ST(1));
}
break;
}
if (gdbm_setopt(db->dbp, opcode, vptr, vsiz)) {
if (gdbm_errno == GDBM_OPT_ILLEGAL)
croak("%s not implemented", opt_names[ix]);
dbcroak(db, "gdbm_setopt");
}
if (vptr == (OPTVALPTR) &c_iv) {
RETVAL = newSViv(c_iv);
} else if (vptr == (OPTVALPTR) &c_uv) {
RETVAL = newSVuv(c_uv);
} else {
RETVAL = newSVpv(c_cv, 0);
free(c_cv);
}
OUTPUT:
RETVAL
#define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen)
int
gdbm_setopt (db, optflag, optval, optlen)
GDBM_File db
int optflag
int &optval
int optlen
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL) {
dbcroak(db, "gdbm_setopt");
}
SV *
filter_fetch_key(db, code)
GDBM_File db
SV * code
SV * RETVAL = &PL_sv_undef ;
ALIAS:
GDBM_File::filter_fetch_key = fetch_key
GDBM_File::filter_store_key = store_key
GDBM_File::filter_fetch_value = fetch_value
GDBM_File::filter_store_value = store_value
CODE:
DBM_setFilter(db->filter[ix], code);
#
# Export/Import API
#
#
# Crash tolerance API
#
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21
#define gdbm_convert(db, flag) gdbm_convert(db->dbp, flag)
int
gdbm_convert(db, flag)
GDBM_File db
int flag
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL) {
dbcroak(db, "gdbm_convert");
}
#define gdbm_failure_atomic(db, even, odd) gdbm_failure_atomic(db->dbp, even, odd)
int
gdbm_failure_atomic(db, even, odd)
GDBM_File db
char * even
char * odd
INIT:
CHECKDB(db);
CLEANUP:
if (RETVAL) {
dbcroak(db, "gdbm_failure_atomic");
}
void
gdbm_latest_snapshot(package, even, odd)
char * even
char * odd
INIT:
int result;
int syserr;
const char * filename;
PPCODE:
result = gdbm_latest_snapshot(even, odd, &filename);
syserr = errno;
if (result == GDBM_SNAPSHOT_OK) {
XPUSHs(sv_2mortal(newSVpv(filename, 0)));
} else {
XPUSHs(&PL_sv_undef);
}
if (GIMME_V == G_ARRAY) {
XPUSHs(sv_2mortal(newSVuv(result)));
if (result == GDBM_SNAPSHOT_ERR)
XPUSHs(sv_2mortal(newSVuv(syserr)));
}
#endif
int
gdbm_crash_tolerance_status(package)
CODE:
#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 21
/*
* The call below returns GDBM_SNAPSHOT_ERR and sets errno to
* EINVAL, if crash tolerance is implemented, or ENOSYS, if it
* is not.
*/
gdbm_latest_snapshot(NULL, NULL, NULL);
RETVAL = (errno != ENOSYS);
#else
RETVAL = 0;
#endif
OUTPUT:
RETVAL