TDB_FileX/TDB_FileX.xs

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

#if __linux__
#include <sys/ioctl.h>
#include <linux/fs.h>
#endif

#include <sys/types.h>
#include <tdb.h>

#define XXH_STATIC_LINKING_ONLY
#define XXH_IMPLEMENTATION
#define XXH_INLINE_ALL
#include "xxHash/xxhash.h"

static void
set_nocow (const char *path, int flags, int mode)
{
  #if __linux__ && FS_NOCOW_FL && O_CLOEXEC
    int fd = open (path, flags, mode | O_CLOEXEC);

    if (fd >= 0)
      {
        int flags;
        if (!ioctl (fd, FS_IOC_GETFLAGS, &flags))
          {
            flags |= FS_NOCOW_FL;
            ioctl (fd, FS_IOC_SETFLAGS, &flags);
          }
    
        close (fd);
      }
  #endif
}

static void
log_func_cb (TDB_CONTEXT *tdb, enum tdb_debug_level level, const char *fmt, ...)
{
  va_list ap;
  bool xfalse = FALSE;
  SV *cb = (SV *)tdb_get_logging_private (tdb);
  
  if (!cb)
    return;

  dSP;
  dXSTARG;

  ENTER;
  SAVETMPS;

  va_start (ap, fmt);

  SV *sv = sv_newmortal ();
  sv_vsetpvfn (sv, fmt, strlen (fmt), &ap, NULL, 0, &xfalse);

  va_end (ap);

  PUSHMARK (SP);
  XPUSHi (level);
  XPUSHs (sv);

  PUTBACK;
  call_sv (cb, G_VOID | G_DISCARD);

  FREETMPS;
  LEAVE;
}

static int
traverse_cb (TDB_CONTEXT *tdb, TDB_DATA key, TDB_DATA data, void *private_data)
{
  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK (SP);
  XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
  XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));
  PUTBACK;

  int count = call_sv ((SV *)private_data, G_SCALAR);

  SPAGAIN;

  if (count != 1)
    croak ("tdb_traverse callback returned %d args\n", count);

  SV *retval = POPs;
  int ret = !SvTRUE (retval);

  PUTBACK;
  FREETMPS;
  LEAVE;

  return ret;
}

static int
check_cb (TDB_DATA key, TDB_DATA data, void *private_data)
{
  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK (SP);
  XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
  XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));

  PUTBACK;
  int count = call_sv ((SV *)private_data, G_SCALAR);
  SPAGAIN;

  if (count != 1)
    croak ("tdb_check callback returned %d args\n", count);

  SV *retval = POPs;
  int ret = SvTRUE (retval) ? 0 : -1;

  PUTBACK;
  FREETMPS;
  LEAVE;

  return ret;
}

static void
rescue_cb (TDB_DATA key, TDB_DATA data, void *private_data)
{
  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK (SP);
  XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
  XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));

  PUTBACK;
  call_sv ((SV *)private_data, G_VOID | G_DISCARD);

  FREETMPS;
  LEAVE;
}

// https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
// https://github.com/skeeto/hash-prospector/issues/19
static unsigned int
fnv1ax_hash (TDB_DATA *key)
{
  unsigned int x = sizeof (unsigned int) < 8 ? 0x811c9dc5U : 0xcbf29ce484222325U;

  for (size_t i = 0; i < key->dsize; ++i)
    x = (x ^ key->dptr[i]) * (sizeof (unsigned int) < 8 ? 0x01000193U : 0x00000100000001b3U);

  x ^= x >> 16; x *= 0x21f0aaadU;
  x ^= x >> 15; x *= 0x735a2d97U;
  x ^= x >> 15;

  return x;
}

static unsigned int
xxh3_hash (TDB_DATA *key)
{
  return XXH3_64bits (key->dptr, key->dsize);
}

static unsigned int
custom_hash (TDB_DATA *key, SV *cb)
{
  dSP;

  ENTER;
  SAVETMPS;

  PUSHMARK (SP);
  XPUSHs (sv_2mortal (newSVpv (key->dptr, key->dsize)));

  PUTBACK;
  int count = call_sv (cb, G_SCALAR);
  SPAGAIN;

  if (count != 1)
    croak ("hash callback returned %d vaslues, expecte4d exactly 1", count);

  unsigned int hash = POPu;

  PUTBACK;
  FREETMPS;
  LEAVE;

  return hash;
}

static void
croak_on_error_slowpath (TDB_CONTEXT *tdb)
{
  errno = tdb_error (tdb);
  croak_sv (sv_2mortal (newSVpv (tdb_errorstr (tdb), 0)));
}

#define croak_on_error(res) do { if ((res) < 0) croak_on_error_slowpath (tdb); } while (0)

static SV *custom_hash_cb[4];

static unsigned int custom_hash_1 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[0]); }
static unsigned int custom_hash_2 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[1]); }
static unsigned int custom_hash_3 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[2]); }
static unsigned int custom_hash_4 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[3]); }

static int
fetch_parser (TDB_DATA key, TDB_DATA data, void *private_data)
{
  SV **svp = (SV **)private_data;
  *svp = newSVpvn (data.dptr, data.dsize);
  return 0;
}

typedef int mone_on_fail;

MODULE = TDB_FileX              PACKAGE = TDB_FileX             PREFIX = tdb_

PROTOTYPES: DISABLE

BOOT:
{
        HV *stash = gv_stashpv ("TDB_FileX", 1);

        static const struct {
          const char *name;
          IV iv;
        } *civ, const_iv[] = {
#         define const_iv(name) { # name, (IV) TDB_ ## name },
          const_iv (ALLOW_NESTING)
          const_iv (BIGENDIAN)
          const_iv (CLEAR_IF_FIRST)
          const_iv (CONVERT)
          const_iv (DEFAULT)
          const_iv (DISALLOW_NESTING)
          const_iv (INCOMPATIBLE_HASH)
          const_iv (INSERT)
          const_iv (INTERNAL)
          const_iv (MODIFY)
          const_iv (MUTEX_LOCKING)
          const_iv (NOLOCK)
          const_iv (NOMMAP)
          const_iv (NOSYNC)
          const_iv (REPLACE)
          const_iv (SEQNUM)
          const_iv (VOLATILE)

          const_iv (ERR_CORRUPT)
          const_iv (ERR_IO)
          const_iv (ERR_LOCK)
          const_iv (ERR_OOM)
          const_iv (ERR_EXISTS)
          const_iv (ERR_NOLOCK)
          const_iv (ERR_LOCK_TIMEOUT)
          const_iv (ERR_NOEXIST)
          const_iv (ERR_EINVAL)
          const_iv (ERR_RDONLY)
          const_iv (SUCCESS)

          const_iv (DEBUG_FATAL)
          const_iv (DEBUG_ERROR)
          const_iv (DEBUG_WARNING)
          const_iv (DEBUG_TRACE)
        };
        
        for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
          newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
        
        tdb_runtime_check_for_robust_mutexes ();
}

SV *
set_hash_function (int idx, SV *cb = 0)
        PROTOTYPE: $;$
        CODE:
{
        if (idx < 1 || idx > 4)
          croak ("hash function index must be between 1 and 4");

        SV **cbp = &custom_hash_cb[idx - 1];

        RETVAL = *cbp ? newSVsv (*cbp) : &PL_sv_undef;

        if (cb)
          {
            SvREFCNT_dec (*cbp);
            *cbp = SvOK (cb) ? newSVsv (cb) : 0;
          }
}
        OUTPUT: RETVAL

void
DESTROY (TDB_CONTEXT *tdb)
        CODE:
        if (tdb)
          {
            SvREFCNT_dec ((SV *)tdb_get_logging_private (tdb));
            tdb_close (tdb);
          }

NO_OUTPUT int
tdb_delete (TDB_CONTEXT *tdb, TDB_DATA key)
        ALIAS:
           DELETE = 0
        POSTCALL:
        croak_on_error (RETVAL);

NO_OUTPUT int
tdb_wipe_all (TDB_CONTEXT *tdb)
        ALIAS:
           CLEAR = 0
        CODE:
        tdb_wipe_all (tdb);
        POSTCALL:
        croak_on_error (RETVAL);

void
tdb_dump_all (TDB_CONTEXT *tdb)

enum TDB_ERROR
tdb_error (TDB_CONTEXT *tdb)

const char *
tdb_errorstr (TDB_CONTEXT *tdb)

SV *
tdb_exists (TDB_CONTEXT *tdb, TDB_DATA key)
        ALIAS:
           EXISTS = 0
        CODE:
        RETVAL = tdb_exists (tdb, key) ? &PL_sv_yes : &PL_sv_no;
        OUTPUT: RETVAL

SV *
tdb_fetch (TDB_CONTEXT *tdb, TDB_DATA key)
        ALIAS:
           FETCH  = 0
        CODE:
        /* tdb_parse_record is faster than tdb_fetch, due to one copy saved */
        /* should use tdb_fetch with perlmulticore */
        RETVAL = 0;
        int res = tdb_parse_record (tdb, key, fetch_parser, &RETVAL);
        if (res < 0)
          {
            SvREFCNT_dec (RETVAL);
            if (tdb_error (tdb) == TDB_ERR_NOEXIST)
              XSRETURN_UNDEF;
            croak_on_error (res);
          }
        OUTPUT: RETVAL

NO_OUTPUT int
tdb_store (TDB_CONTEXT *tdb, TDB_DATA key, TDB_DATA dbuf, int flag = TDB_REPLACE)
        ALIAS:
           STORE = 0
        POSTCALL:
        croak_on_error (RETVAL);

NO_OUTPUT int
tdb_append (TDB_CONTEXT *tdb, TDB_DATA key, TDB_DATA dbuf)
        POSTCALL:
        croak_on_error (RETVAL);

TDB_DATA
tdb_firstkey (TDB_CONTEXT *tdb)
        ALIAS:
           FIRSTKEY = 0

NO_OUTPUT int
tdb_context_only_and_mone_on_fail (TDB_CONTEXT *tdb)
        INTERFACE:
        tdb_lockall
        tdb_unlockall
        tdb_lockall_read
        tdb_unlockall_read
        tdb_lockall_mark
        tdb_lockall_unmark
        tdb_transaction_start
        tdb_transaction_cancel
        tdb_transaction_commit
        tdb_transaction_prepare_commit
        tdb_repack
        POSTCALL:
        croak_on_error (RETVAL);

bool
tdb_context_only_and_mone_on_fail_nonblock (TDB_CONTEXT *tdb)
        INTERFACE:
        tdb_lockall_nonblock
        tdb_lockall_read_nonblock
        tdb_transaction_start_nonblock
        POSTCALL:
        if (RETVAL < 0)
          {
            if (tdb_error (tdb) != TDB_ERR_LOCK)
              croak_on_error (RETVAL);

            RETVAL = 0;
          }
        else
          RETVAL = 1;

bool         tdb_transaction_active               (TDB_CONTEXT *tdb)

void         tdb_enable_seqnum                    (TDB_CONTEXT *tdb)

int          tdb_get_seqnum                       (TDB_CONTEXT *tdb)

void         tdb_increment_seqnum_nonblock        (TDB_CONTEXT *tdb)

int          tdb_hash_size                        (TDB_CONTEXT *tdb)

size_t       tdb_map_size                         (TDB_CONTEXT *tdb)

int          tdb_get_flags                        (TDB_CONTEXT *tdb)

void         tdb_add_flags                        (TDB_CONTEXT *tdb, unsigned int flag)

void         tdb_remove_flags                     (TDB_CONTEXT *tdb, unsigned int flag)

bool         tdb_runtime_check_for_robust_mutexes ()

void
tdb_set_logging_function (TDB_CONTEXT *tdb, SV *cb)
        CODE:
        struct tdb_logging_context ctx;
        ctx.log_fn = log_func_cb;
        ctx.log_private = (SV *)newSVsv (cb);
        SvREFCNT_dec ((SV *)tdb_get_logging_private (tdb));
        tdb_set_logging_function (tdb, &ctx);

TDB_DATA
tdb_nextkey (TDB_CONTEXT *tdb, TDB_DATA key)
        ALIAS:
           NEXTKEY = 0

TDB_CONTEXT *
tdb_open (char *class, char *path, ...)
        ALIAS:
           TIEHASH = 0
        CODE:
        tdb_hash_func hash_func = 0;
        struct tdb_logging_context ctx = { 0 };
        int tdb_flags = TDB_DEFAULT;
        int open_flags = O_RDWR | O_CREAT;
        mode_t mode = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
        int hash_size = 0;
        int nocow = 0;

        for (int i = 2; i < items - 1; i += 2)
          {
            const char *k = SvPVbyte_nolen (ST (i));
            SV         *v = ST (i + 1);

            if      (strEQ (k, "tdb_flags" )) tdb_flags  = SvIV (v);
            else if (strEQ (k, "open_flags")) open_flags = SvIV (v);
            else if (strEQ (k, "mode"      )) mode       = SvUV (v);
            else if (strEQ (k, "hash_size" )) hash_size  = SvIV (v);
            else if (strEQ (k, "log_cb"))
              {
                SvREFCNT_dec (ctx.log_private);
                ctx.log_fn = 0;
                ctx.log_private = 0;

                if (SvOK (v))
                  {
                    ctx.log_fn = log_func_cb;
                    ctx.log_private = (void *)newSVsv (v);
                  }
              }
            else if (strEQ (k, "hash"))
              {
                const char *f = SvPVbyte_nolen (v);

                if      (!SvOK (v)           ) hash_func = 0;
                else if (strEQ (f, "default")) hash_func = 0;
                else if (strEQ (f, "jenkins")) hash_func = tdb_jenkins_hash;
                else if (strEQ (f, "fnv1ax" )) hash_func = fnv1ax_hash;
                else if (strEQ (f, "xxh3"   )) hash_func = xxh3_hash;
                else if (strEQ (f, "1"      )) hash_func = custom_hash_1;
                else if (strEQ (f, "2"      )) hash_func = custom_hash_2;
                else if (strEQ (f, "3"      )) hash_func = custom_hash_3;
                else if (strEQ (f, "4"      )) hash_func = custom_hash_4;
                else
                  croak ("%s: not a known hash function", f);
              }
            else if (strEQ (k, "mutex"))
              {
                if (SvTRUE (v))
                  {
                    if (tdb_runtime_check_for_robust_mutexes ())
                      tdb_flags |= TDB_MUTEX_LOCKING;
                  }
                else
                  tdb_flags &= ~TDB_MUTEX_LOCKING;
              }
            else if (strEQ (k, "nocow"))
              nocow = SvTRUE (v);
            else
              croak ("%s: not a known parameter name", k);
          }

        if (nocow && (open_flags & O_CREAT) && !(tdb_flags & TDB_INTERNAL))
          set_nocow (path, open_flags, mode);

        RETVAL = tdb_open_ex (path, hash_size, tdb_flags, open_flags, mode, ctx.log_fn ? &ctx : 0, hash_func);

        if (!RETVAL)
          {
            SvREFCNT_dec ((SV *)ctx.log_private);
            XSRETURN_UNDEF;
          }
        OUTPUT: RETVAL

void
tdb_printfreelist (TDB_CONTEXT *tdb)

int
tdb_freelist_size (TDB_CONTEXT *tdb)

char *
tdb_summary (TDB_CONTEXT *tdb)
        CLEANUP:
        free (RETVAL);

void
tdb_reopen (TDB_CONTEXT *tdb)
        PROTOTYPE:
        CODE:
        void *logcb = tdb_get_logging_private (tdb);

        int res = tdb_reopen (tdb);

        if (res < 0)
          {
            /* tdb_reopen frees the TDB_CONTEXT on failure,
             * so set scalar value to 0 to avoid double free on DESTROY */
            sv_setiv ((SV*)SvRV (ST (0)), 0);
            SvREFCNT_dec ((SV *)logcb);
            croak ("tdb_reopen failed");
          }

# FIXME: if this fails, we need to undef $tdb or something
# .. which we can't do - cos we don't know where it failed :(
# maybe reimplement this ourselves?
NO_OUTPUT int
tdb_reopen_all (int parent_longlived = 0)
        POSTCALL:
        if (RETVAL < 0)
          croak ("tdb_reopen_all failed");

int
tdb_fd (TDB_CONTEXT *tdb)

const char *
tdb_name (TDB_CONTEXT *tdb)

int
tdb_traverse (TDB_CONTEXT *tdb, SV *fn = &PL_sv_undef)
        ALIAS:
           tdb_traverse_read = 1
        CODE:
        RETVAL = (ix ? tdb_traverse_read : tdb_traverse) (tdb, SvOK (fn) ? traverse_cb: 0, fn);
        croak_on_error (RETVAL);
        OUTPUT: RETVAL

mone_on_fail
tdb_check (TDB_CONTEXT *tdb, SV *fn = &PL_sv_undef)
        CODE:
        RETVAL = tdb_check (tdb, SvOK (fn) ? check_cb : 0, fn);
        OUTPUT: RETVAL

mone_on_fail
tdb_rescue (TDB_CONTEXT *tdb, SV *fn)
        CODE:
        RETVAL = tdb_rescue (tdb, rescue_cb, fn);
        OUTPUT: RETVAL

Revision:	1.8
Committed:	Fri May 2 22:25:44 2025 UTC (16 months, 1 week ago) by root
Branch:	MAIN
Changes since 1.7:	+22 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5	root	1.4	#if __linux__
6			#include <sys/ioctl.h>
7			#include <linux/fs.h>
8			#endif
9
10	root	1.1	#include <sys/types.h>
11			#include <tdb.h>
12
13			#define XXH_STATIC_LINKING_ONLY
14			#define XXH_IMPLEMENTATION
15			#define XXH_INLINE_ALL
16			#include "xxHash/xxhash.h"
17
18			static void
19	root	1.4	set_nocow (const char *path, int flags, int mode)
20			{
21			#if __linux__ && FS_NOCOW_FL && O_CLOEXEC
22			int fd = open (path, flags, mode \| O_CLOEXEC);
23
24			if (fd >= 0)
25			{
26			int flags;
27			if (!ioctl (fd, FS_IOC_GETFLAGS, &flags))
28			{
29			flags \|= FS_NOCOW_FL;
30			ioctl (fd, FS_IOC_SETFLAGS, &flags);
31			}
32
33			close (fd);
34			}
35			#endif
36			}
37
38			static void
39	root	1.1	log_func_cb (TDB_CONTEXT tdb, enum tdb_debug_level level, const char fmt, ...)
40			{
41			va_list ap;
42			bool xfalse = FALSE;
43			SV cb = (SV )tdb_get_logging_private (tdb);
44
45			if (!cb)
46			return;
47
48			dSP;
49			dXSTARG;
50
51			ENTER;
52			SAVETMPS;
53
54			va_start (ap, fmt);
55
56			SV *sv = sv_newmortal ();
57			sv_vsetpvfn (sv, fmt, strlen (fmt), &ap, NULL, 0, &xfalse);
58
59			va_end (ap);
60
61			PUSHMARK (SP);
62			XPUSHi (level);
63			XPUSHs (sv);
64	root	1.3
65	root	1.1	PUTBACK;
66			call_sv (cb, G_VOID \| G_DISCARD);
67
68			FREETMPS;
69			LEAVE;
70			}
71
72			static int
73	root	1.3	traverse_cb (TDB_CONTEXT tdb, TDB_DATA key, TDB_DATA data, void private_data)
74	root	1.1	{
75			dSP;
76
77			ENTER;
78			SAVETMPS;
79
80			PUSHMARK (SP);
81			XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
82			XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));
83			PUTBACK;
84
85	root	1.3	int count = call_sv ((SV *)private_data, G_SCALAR);
86	root	1.1
87			SPAGAIN;
88
89			if (count != 1)
90			croak ("tdb_traverse callback returned %d args\n", count);
91
92			SV *retval = POPs;
93			int ret = !SvTRUE (retval);
94
95			PUTBACK;
96			FREETMPS;
97			LEAVE;
98
99			return ret;
100			}
101
102	root	1.3	static int
103			check_cb (TDB_DATA key, TDB_DATA data, void *private_data)
104			{
105			dSP;
106
107			ENTER;
108			SAVETMPS;
109
110			PUSHMARK (SP);
111			XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
112			XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));
113
114			PUTBACK;
115			int count = call_sv ((SV *)private_data, G_SCALAR);
116			SPAGAIN;
117
118			if (count != 1)
119			croak ("tdb_check callback returned %d args\n", count);
120
121			SV *retval = POPs;
122			int ret = SvTRUE (retval) ? 0 : -1;
123
124			PUTBACK;
125			FREETMPS;
126			LEAVE;
127
128			return ret;
129			}
130
131			static void
132			rescue_cb (TDB_DATA key, TDB_DATA data, void *private_data)
133			{
134			dSP;
135
136			ENTER;
137			SAVETMPS;
138
139			PUSHMARK (SP);
140			XPUSHs (sv_2mortal (newSVpv (key .dptr, key .dsize)));
141			XPUSHs (sv_2mortal (newSVpv (data.dptr, data.dsize)));
142
143			PUTBACK;
144			call_sv ((SV *)private_data, G_VOID \| G_DISCARD);
145
146			FREETMPS;
147			LEAVE;
148			}
149
150	root	1.1	// https://en.wikipedia.org/wiki/Fowler%E2%80%93Noll%E2%80%93Vo_hash_function
151			// https://github.com/skeeto/hash-prospector/issues/19
152			static unsigned int
153			fnv1ax_hash (TDB_DATA *key)
154			{
155			unsigned int x = sizeof (unsigned int) < 8 ? 0x811c9dc5U : 0xcbf29ce484222325U;
156
157			for (size_t i = 0; i < key->dsize; ++i)
158			x = (x ^ key->dptr[i]) * (sizeof (unsigned int) < 8 ? 0x01000193U : 0x00000100000001b3U);
159
160			x ^= x >> 16; x *= 0x21f0aaadU;
161			x ^= x >> 15; x *= 0x735a2d97U;
162			x ^= x >> 15;
163
164			return x;
165			}
166
167			static unsigned int
168			xxh3_hash (TDB_DATA *key)
169			{
170			return XXH3_64bits (key->dptr, key->dsize);
171			}
172
173			static unsigned int
174			custom_hash (TDB_DATA key, SV cb)
175			{
176			dSP;
177
178			ENTER;
179			SAVETMPS;
180
181			PUSHMARK (SP);
182			XPUSHs (sv_2mortal (newSVpv (key->dptr, key->dsize)));
183	root	1.3
184	root	1.1	PUTBACK;
185			int count = call_sv (cb, G_SCALAR);
186			SPAGAIN;
187
188			if (count != 1)
189			croak ("hash callback returned %d vaslues, expecte4d exactly 1", count);
190
191			unsigned int hash = POPu;
192
193			PUTBACK;
194			FREETMPS;
195			LEAVE;
196
197			return hash;
198			}
199
200	root	1.2	static void
201			croak_on_error_slowpath (TDB_CONTEXT *tdb)
202			{
203			errno = tdb_error (tdb);
204			croak_sv (sv_2mortal (newSVpv (tdb_errorstr (tdb), 0)));
205			}
206
207			#define croak_on_error(res) do { if ((res) < 0) croak_on_error_slowpath (tdb); } while (0)
208
209	root	1.1	static SV *custom_hash_cb[4];
210
211			static unsigned int custom_hash_1 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[0]); }
212			static unsigned int custom_hash_2 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[1]); }
213			static unsigned int custom_hash_3 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[2]); }
214			static unsigned int custom_hash_4 (TDB_DATA *key) { return custom_hash (key, custom_hash_cb[3]); }
215
216	root	1.8	static int
217			fetch_parser (TDB_DATA key, TDB_DATA data, void *private_data)
218			{
219			SV svp = (SV )private_data;
220			*svp = newSVpvn (data.dptr, data.dsize);
221			return 0;
222			}
223
224	root	1.1	typedef int mone_on_fail;
225
226			MODULE = TDB_FileX PACKAGE = TDB_FileX PREFIX = tdb_
227
228			PROTOTYPES: DISABLE
229
230			BOOT:
231			{
232			HV *stash = gv_stashpv ("TDB_FileX", 1);
233
234			static const struct {
235			const char *name;
236			IV iv;
237			} *civ, const_iv[] = {
238			# define const_iv(name) { # name, (IV) TDB_ ## name },
239			const_iv (ALLOW_NESTING)
240			const_iv (BIGENDIAN)
241			const_iv (CLEAR_IF_FIRST)
242			const_iv (CONVERT)
243			const_iv (DEFAULT)
244			const_iv (DISALLOW_NESTING)
245			const_iv (INCOMPATIBLE_HASH)
246			const_iv (INSERT)
247			const_iv (INTERNAL)
248			const_iv (MODIFY)
249			const_iv (MUTEX_LOCKING)
250			const_iv (NOLOCK)
251			const_iv (NOMMAP)
252			const_iv (NOSYNC)
253			const_iv (REPLACE)
254			const_iv (SEQNUM)
255			const_iv (VOLATILE)
256
257			const_iv (ERR_CORRUPT)
258			const_iv (ERR_IO)
259			const_iv (ERR_LOCK)
260			const_iv (ERR_OOM)
261			const_iv (ERR_EXISTS)
262			const_iv (ERR_NOLOCK)
263			const_iv (ERR_LOCK_TIMEOUT)
264			const_iv (ERR_NOEXIST)
265			const_iv (ERR_EINVAL)
266			const_iv (ERR_RDONLY)
267			const_iv (SUCCESS)
268
269			const_iv (DEBUG_FATAL)
270			const_iv (DEBUG_ERROR)
271			const_iv (DEBUG_WARNING)
272			const_iv (DEBUG_TRACE)
273			};
274
275			for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ > const_iv; civ--)
276			newCONSTSUB (stash, (char *)civ[-1].name, newSViv (civ[-1].iv));
277
278			tdb_runtime_check_for_robust_mutexes ();
279			}
280
281			SV *
282			set_hash_function (int idx, SV *cb = 0)
283			PROTOTYPE: $;$
284			CODE:
285			{
286			if (idx < 1 \|\| idx > 4)
287			croak ("hash function index must be between 1 and 4");
288
289			SV **cbp = &custom_hash_cb[idx - 1];
290
291			RETVAL = cbp ? newSVsv (cbp) : &PL_sv_undef;
292
293			if (cb)
294			{
295			SvREFCNT_dec (*cbp);
296			*cbp = SvOK (cb) ? newSVsv (cb) : 0;
297			}
298			}
299			OUTPUT: RETVAL
300
301			void
302			DESTROY (TDB_CONTEXT *tdb)
303			CODE:
304			if (tdb)
305			{
306			SvREFCNT_dec ((SV *)tdb_get_logging_private (tdb));
307			tdb_close (tdb);
308			}
309
310	root	1.2	NO_OUTPUT int
311	root	1.1	tdb_delete (TDB_CONTEXT *tdb, TDB_DATA key)
312			ALIAS:
313			DELETE = 0
314	root	1.2	POSTCALL:
315			croak_on_error (RETVAL);
316	root	1.1
317	root	1.2	NO_OUTPUT int
318	root	1.1	tdb_wipe_all (TDB_CONTEXT *tdb)
319			ALIAS:
320			CLEAR = 0
321			CODE:
322			tdb_wipe_all (tdb);
323	root	1.2	POSTCALL:
324			croak_on_error (RETVAL);
325	root	1.1
326			void
327			tdb_dump_all (TDB_CONTEXT *tdb)
328
329			enum TDB_ERROR
330			tdb_error (TDB_CONTEXT *tdb)
331
332			const char *
333			tdb_errorstr (TDB_CONTEXT *tdb)
334
335	root	1.2	SV *
336	root	1.1	tdb_exists (TDB_CONTEXT *tdb, TDB_DATA key)
337			ALIAS:
338			EXISTS = 0
339	root	1.2	CODE:
340			RETVAL = tdb_exists (tdb, key) ? &PL_sv_yes : &PL_sv_no;
341			OUTPUT: RETVAL
342	root	1.1
343	root	1.8	SV *
344	root	1.1	tdb_fetch (TDB_CONTEXT *tdb, TDB_DATA key)
345			ALIAS:
346			FETCH = 0
347	root	1.8	CODE:
348			/* tdb_parse_record is faster than tdb_fetch, due to one copy saved */
349			/* should use tdb_fetch with perlmulticore */
350			RETVAL = 0;
351			int res = tdb_parse_record (tdb, key, fetch_parser, &RETVAL);
352			if (res < 0)
353			{
354			SvREFCNT_dec (RETVAL);
355			if (tdb_error (tdb) == TDB_ERR_NOEXIST)
356			XSRETURN_UNDEF;
357			croak_on_error (res);
358			}
359			OUTPUT: RETVAL
360	root	1.1
361	root	1.2	NO_OUTPUT int
362			tdb_store (TDB_CONTEXT *tdb, TDB_DATA key, TDB_DATA dbuf, int flag = TDB_REPLACE)
363			ALIAS:
364			STORE = 0
365			POSTCALL:
366			croak_on_error (RETVAL);
367
368			NO_OUTPUT int
369	root	1.1	tdb_append (TDB_CONTEXT *tdb, TDB_DATA key, TDB_DATA dbuf)
370	root	1.2	POSTCALL:
371			croak_on_error (RETVAL);
372	root	1.1
373			TDB_DATA
374			tdb_firstkey (TDB_CONTEXT *tdb)
375			ALIAS:
376			FIRSTKEY = 0
377
378	root	1.2	NO_OUTPUT int
379			tdb_context_only_and_mone_on_fail (TDB_CONTEXT *tdb)
380			INTERFACE:
381			tdb_lockall
382			tdb_unlockall
383			tdb_lockall_read
384			tdb_unlockall_read
385			tdb_lockall_mark
386			tdb_lockall_unmark
387			tdb_transaction_start
388			tdb_transaction_cancel
389			tdb_transaction_commit
390			tdb_transaction_prepare_commit
391			tdb_repack
392			POSTCALL:
393			croak_on_error (RETVAL);
394	root	1.1
395	root	1.6	bool
396			tdb_context_only_and_mone_on_fail_nonblock (TDB_CONTEXT *tdb)
397			INTERFACE:
398			tdb_lockall_nonblock
399			tdb_lockall_read_nonblock
400			tdb_transaction_start_nonblock
401			POSTCALL:
402			if (RETVAL < 0)
403			{
404			if (tdb_error (tdb) != TDB_ERR_LOCK)
405			croak_on_error (RETVAL);
406
407			RETVAL = 0;
408			}
409			else
410			RETVAL = 1;
411
412	root	1.1	bool tdb_transaction_active (TDB_CONTEXT *tdb)
413
414			void tdb_enable_seqnum (TDB_CONTEXT *tdb)
415
416			int tdb_get_seqnum (TDB_CONTEXT *tdb)
417
418			void tdb_increment_seqnum_nonblock (TDB_CONTEXT *tdb)
419
420			int tdb_hash_size (TDB_CONTEXT *tdb)
421
422			size_t tdb_map_size (TDB_CONTEXT *tdb)
423
424			int tdb_get_flags (TDB_CONTEXT *tdb)
425
426			void tdb_add_flags (TDB_CONTEXT *tdb, unsigned int flag)
427
428			void tdb_remove_flags (TDB_CONTEXT *tdb, unsigned int flag)
429
430			bool tdb_runtime_check_for_robust_mutexes ()
431
432			void
433			tdb_set_logging_function (TDB_CONTEXT tdb, SV cb)
434			CODE:
435			struct tdb_logging_context ctx;
436			ctx.log_fn = log_func_cb;
437			ctx.log_private = (SV *)newSVsv (cb);
438			SvREFCNT_dec ((SV *)tdb_get_logging_private (tdb));
439			tdb_set_logging_function (tdb, &ctx);
440
441			TDB_DATA
442			tdb_nextkey (TDB_CONTEXT *tdb, TDB_DATA key)
443			ALIAS:
444			NEXTKEY = 0
445
446			TDB_CONTEXT *
447			tdb_open (char class, char path, ...)
448			ALIAS:
449			TIEHASH = 0
450			CODE:
451			tdb_hash_func hash_func = 0;
452			struct tdb_logging_context ctx = { 0 };
453			int tdb_flags = TDB_DEFAULT;
454			int open_flags = O_RDWR \| O_CREAT;
455			mode_t mode = S_IRUSR \| S_IWUSR \| S_IRGRP \| S_IWGRP \| S_IROTH \| S_IWOTH;
456			int hash_size = 0;
457	root	1.4	int nocow = 0;
458	root	1.1
459			for (int i = 2; i < items - 1; i += 2)
460			{
461			const char *k = SvPVbyte_nolen (ST (i));
462			SV *v = ST (i + 1);
463
464			if (strEQ (k, "tdb_flags" )) tdb_flags = SvIV (v);
465			else if (strEQ (k, "open_flags")) open_flags = SvIV (v);
466			else if (strEQ (k, "mode" )) mode = SvUV (v);
467			else if (strEQ (k, "hash_size" )) hash_size = SvIV (v);
468			else if (strEQ (k, "log_cb"))
469			{
470			SvREFCNT_dec (ctx.log_private);
471			ctx.log_fn = 0;
472			ctx.log_private = 0;
473
474			if (SvOK (v))
475			{
476			ctx.log_fn = log_func_cb;
477			ctx.log_private = (void *)newSVsv (v);
478			}
479			}
480			else if (strEQ (k, "hash"))
481			{
482			const char *f = SvPVbyte_nolen (v);
483
484			if (!SvOK (v) ) hash_func = 0;
485			else if (strEQ (f, "default")) hash_func = 0;
486			else if (strEQ (f, "jenkins")) hash_func = tdb_jenkins_hash;
487			else if (strEQ (f, "fnv1ax" )) hash_func = fnv1ax_hash;
488			else if (strEQ (f, "xxh3" )) hash_func = xxh3_hash;
489			else if (strEQ (f, "1" )) hash_func = custom_hash_1;
490			else if (strEQ (f, "2" )) hash_func = custom_hash_2;
491			else if (strEQ (f, "3" )) hash_func = custom_hash_3;
492			else if (strEQ (f, "4" )) hash_func = custom_hash_4;
493			else
494			croak ("%s: not a known hash function", f);
495			}
496			else if (strEQ (k, "mutex"))
497			{
498			if (SvTRUE (v))
499			{
500			if (tdb_runtime_check_for_robust_mutexes ())
501			tdb_flags \|= TDB_MUTEX_LOCKING;
502			}
503			else
504			tdb_flags &= ~TDB_MUTEX_LOCKING;
505			}
506	root	1.4	else if (strEQ (k, "nocow"))
507			nocow = SvTRUE (v);
508	root	1.1	else
509			croak ("%s: not a known parameter name", k);
510			}
511
512	root	1.5	if (nocow && (open_flags & O_CREAT) && !(tdb_flags & TDB_INTERNAL))
513	root	1.4	set_nocow (path, open_flags, mode);
514
515	root	1.1	RETVAL = tdb_open_ex (path, hash_size, tdb_flags, open_flags, mode, ctx.log_fn ? &ctx : 0, hash_func);
516
517			if (!RETVAL)
518			{
519			SvREFCNT_dec ((SV *)ctx.log_private);
520			XSRETURN_UNDEF;
521			}
522			OUTPUT: RETVAL
523
524			void
525			tdb_printfreelist (TDB_CONTEXT *tdb)
526
527	root	1.7	int
528			tdb_freelist_size (TDB_CONTEXT *tdb)
529
530			char *
531			tdb_summary (TDB_CONTEXT *tdb)
532			CLEANUP:
533			free (RETVAL);
534
535	root	1.2	void
536	root	1.1	tdb_reopen (TDB_CONTEXT *tdb)
537			PROTOTYPE:
538			CODE:
539			void *logcb = tdb_get_logging_private (tdb);
540
541	root	1.2	int res = tdb_reopen (tdb);
542	root	1.1
543	root	1.2	if (res < 0)
544	root	1.1	{
545			/* tdb_reopen frees the TDB_CONTEXT on failure,
546			* so set scalar value to 0 to avoid double free on DESTROY */
547			sv_setiv ((SV*)SvRV (ST (0)), 0);
548			SvREFCNT_dec ((SV *)logcb);
549	root	1.2	croak ("tdb_reopen failed");
550	root	1.1	}
551
552			# FIXME: if this fails, we need to undef $tdb or something
553			# .. which we can't do - cos we don't know where it failed :(
554			# maybe reimplement this ourselves?
555	root	1.2	NO_OUTPUT int
556	root	1.1	tdb_reopen_all (int parent_longlived = 0)
557	root	1.2	POSTCALL:
558			if (RETVAL < 0)
559			croak ("tdb_reopen_all failed");
560	root	1.1
561			int
562			tdb_fd (TDB_CONTEXT *tdb)
563
564			const char *
565			tdb_name (TDB_CONTEXT *tdb)
566
567			int
568			tdb_traverse (TDB_CONTEXT tdb, SV fn = &PL_sv_undef)
569			ALIAS:
570			tdb_traverse_read = 1
571			CODE:
572	root	1.2	RETVAL = (ix ? tdb_traverse_read : tdb_traverse) (tdb, SvOK (fn) ? traverse_cb: 0, fn);
573			croak_on_error (RETVAL);
574	root	1.1	OUTPUT: RETVAL
575
576	root	1.3	mone_on_fail
577			tdb_check (TDB_CONTEXT tdb, SV fn = &PL_sv_undef)
578			CODE:
579			RETVAL = tdb_check (tdb, SvOK (fn) ? check_cb : 0, fn);
580			OUTPUT: RETVAL
581
582			mone_on_fail
583			tdb_rescue (TDB_CONTEXT tdb, SV fn)
584			CODE:
585			RETVAL = tdb_rescue (tdb, rescue_cb, fn);
586			OUTPUT: RETVAL
587