1 #define PERL_NO_GET_CONTEXT
2 #include "EXTERN.h"
3 #include "perl.h"
4 #include "XSUB.h"
5
6 #include "ppport.h"
7
8 /* Perl portability code */
9 #ifndef cxinc
10 #define cxinc() Perl_cxinc(aTHX)
11 #endif
12
13 #ifdef SV_UNDEF_RETURNS_NULL
14 #define MySvPV(sv, len) SvPV_flags(sv, len, SV_GMAGIC|SV_UNDEF_RETURNS_NULL)
15 #else
16 #define MySvPV(sv, len) (SvOK(sv)?SvPV_flags(sv, len, SV_GMAGIC):((len=0), NULL))
17 #endif
18
19 #ifndef caller_cx
20 /* Copied from pp_ctl.c for pre 5.13.5 */
21 STATIC I32
S_dopoptosub_at(pTHX_ const PERL_CONTEXT * cxstk,I32 startingblock)22 S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock)
23 {
24 dVAR;
25 I32 i;
26 for (i = startingblock; i >= 0; i--) {
27 register const PERL_CONTEXT * const cx = &cxstk[i];
28 switch (CxTYPE(cx)) {
29 default:
30 continue;
31 case CXt_EVAL:
32 case CXt_SUB:
33 case CXt_FORMAT:
34 return i;
35 }
36 }
37 return i;
38 }
39 #define dopoptosub_at(c,s) S_dopoptosub_at(aTHX_ c,s)
40
41 STATIC const PERL_CONTEXT *
Perl_caller_cx(pTHX_ I32 count,const PERL_CONTEXT ** dbcxp)42 Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
43 {
44 I32 cxix = dopoptosub_at(cxstack, cxstack_ix);
45 const PERL_CONTEXT *cx;
46 const PERL_CONTEXT *ccstack = cxstack;
47 const PERL_SI *top_si = PL_curstackinfo;
48
49 for (;;) {
50 while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
51 top_si = top_si->si_prev;
52 ccstack = top_si->si_cxstack;
53 cxix = dopoptosub_at(ccstack, top_si->si_cxix);
54 }
55 if (cxix < 0)
56 return NULL;
57 if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
58 ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
59 count++;
60 if (!count--)
61 break;
62 cxix = dopoptosub_at(ccstack, cxix - 1);
63 }
64
65 cx = &ccstack[cxix];
66 if (dbcxp) *dbcxp = cx;
67
68 if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
69 const I32 dbcxix = dopoptosub_at(ccstack, cxix - 1);
70 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
71 cx = &ccstack[dbcxix];
72 }
73
74 return cx;
75 }
76 #define caller_cx(count, dbcxp) Perl_caller_cx(aTHX_ count, dbcxp);
77 #endif
78
79 /*
80 * Can't use standard SvPVutf8 because the potential upgrade is in place
81 * and modifying a user scalar in any way is bad practice unless expected.
82 */
83 STATIC char *
S_mySvPVutf8(pTHX_ SV * sv,STRLEN * const len)84 S_mySvPVutf8(pTHX_ SV *sv, STRLEN *const len) {
85 if(!SvOK(sv)) {
86 *len = 0;
87 return NULL;
88 }
89 SvGETMAGIC(sv);
90 if(!SvUTF8(sv)) {
91 sv = sv_mortalcopy(sv);
92 sv_utf8_upgrade_nomg(sv);
93 }
94 return SvPV_nomg(sv, *len);
95 }
96 #define MySvPVutf8(sv, len) S_mySvPVutf8(aTHX_ sv, &len)
97
98 #include <lmdb.h>
99
100 /* My own exportable constants */
101 #define LMDB_OFLAGN 2
102 #define LMDB_ZEROCOPY 0x0001
103 #define LMDB_UTF8 0x0002
104
105 #include "const-c.inc"
106
107 #define F_ISSET(w, f) (((w) & (f)) == (f))
108 #define TOHIWORD(F) ((F) << 16)
109 #define StoreUV(k, v) (void)hv_store(RETVAL, (k), sizeof(k) - 1, newSVuv(v), 0)
110
111 typedef IV MyInt;
112
113 static void
populateStat(pTHX_ HV ** hashptr,int res,MDB_stat * stat)114 populateStat(pTHX_ HV** hashptr, int res, MDB_stat *stat)
115 {
116 HV* RETVAL;
117 if(res)
118 croak(mdb_strerror(res));
119 RETVAL = newHV();
120 StoreUV("psize", stat->ms_psize);
121 StoreUV("depth", stat->ms_depth);
122 StoreUV("branch_pages", stat->ms_branch_pages);
123 StoreUV("leaf_pages", stat->ms_leaf_pages);
124 StoreUV("overflow_pages", stat->ms_overflow_pages);
125 StoreUV("entries", stat->ms_entries);
126 *hashptr = RETVAL;
127 }
128
129 typedef MDB_env* LMDB__Env;
130 typedef MDB_txn* LMDB__Txn;
131 typedef MDB_txn* TxnOrNull;
132 typedef MDB_dbi LMDB;
133 typedef MDB_val DBD;
134 typedef MDB_val DBK;
135 typedef MDB_val DBKC;
136 typedef MDB_cursor* LMDB__Cursor;
137 typedef unsigned int flags_t;
138
139 #define MY_CXT_KEY "LMDB_File::_guts" XS_VERSION
140
141 typedef struct {
142 LMDB__Env envid;
143 AV *DCmps;
144 AV *Cmps;
145 SV *OFlags;
146 LMDB curdb;
147 unsigned int cflags;
148 SV *my_asv;
149 SV *my_bsv;
150 OP *lmdb_dcmp_cop;
151 } my_cxt_t;
152
153 START_MY_CXT
154
155 #define LMDB_OFLAGS TOHIWORD(Perl_do_vecget(aTHX_ MY_CXT.OFlags, dbi, LMDB_OFLAGN))
156 #define MY_CMP *av_fetch(MY_CXT.Cmps, MY_CXT.curdb, 1)
157 #define MY_DCMP *av_fetch(MY_CXT.DCmps, MY_CXT.curdb, 1)
158
159 #define CHECK_ALLCUR \
160 envid = mdb_txn_env(txn); \
161 if(envid != MY_CXT.envid) { \
162 SV* eidx = sv_2mortal(newSVuv(PTR2UV(MY_CXT.envid = envid))); \
163 HE* enve = hv_fetch_ent(get_hv("LMDB::Env::Envs", 0), eidx, 0, 0); \
164 AV* hh = (AV*)SvRV(HeVAL(enve)); \
165 MY_CXT.DCmps = (AV *)SvRV(*av_fetch(hh, 1, 0)); \
166 MY_CXT.Cmps = (AV *)SvRV(*av_fetch(hh, 2, 0)); \
167 MY_CXT.OFlags = *av_fetch(hh, 3, 0); \
168 MY_CXT.curdb = 0; /* Invalidate cached */ \
169 } \
170 if(MY_CXT.curdb != dbi) { \
171 MY_CXT.curdb = dbi; \
172 mdb_dbi_flags(txn, dbi, &MY_CXT.cflags); \
173 MY_CXT.cflags |= LMDB_OFLAGS; \
174 } \
175 my_cmpsv = MY_CMP; \
176 my_dcmpsv = MY_DCMP
177
178
179 #define ISDBKINT F_ISSET(MY_CXT.cflags, MDB_INTEGERKEY)
180 #define ISDBDINT F_ISSET(MY_CXT.cflags, MDB_DUPSORT|MDB_INTEGERDUP)
181 #define LwZEROCOPY F_ISSET(MY_CXT.cflags, TOHIWORD(LMDB_ZEROCOPY))
182 #define LwUTF8 F_ISSET(MY_CXT.cflags, TOHIWORD(LMDB_UTF8))
183
184 #define dCURSOR MDB_txn* txn; MDB_dbi dbi
185 #define PREC_FLGS(c) txn = mdb_cursor_txn(c); dbi = mdb_cursor_dbi(c); CHECK_ALLCUR
186
187 #define Sv2DBD(sv, data) \
188 if(ISDBDINT) { \
189 SvIV_please(sv); \
190 data.mv_data = &(((XPVIV*)SvANY(sv))->xiv_iv); \
191 data.mv_size = sizeof(MyInt); \
192 } \
193 else data.mv_data = LwUTF8 ? MySvPVutf8(sv, data.mv_size) \
194 : MySvPV(sv, data.mv_size)
195
196 /* ZeroCopy support
197 *
198 * The following code was originally copied from Leon Timmermans's File::Map module
199 *
200 * This software is copyright (c) 2008, 2009 by Leon Timmermans <leont@cpan.org>.
201 * This is free software; you can redistribute it and/or modify it under
202 * the same terms as perl itself.
203 */
204
205 #define MMAP_MAGIC_NUMBER 0x4c4d
206
207 struct mmap_info {
208 void* real_address; /* Currently unused */
209 void* fake_address;
210 size_t real_length; /* Currently unused */
211 size_t fake_length;
212 int isutf8;
213 #ifdef USE_ITHREADS
214 perl_mutex count_mutex;
215 perl_mutex data_mutex;
216 PerlInterpreter* owner;
217 perl_cond cond;
218 int count;
219 #endif
220 };
221
222 static void
reset_var(pTHX_ SV * var,struct mmap_info * info)223 reset_var(pTHX_ SV* var, struct mmap_info* info) {
224 SvPVX(var) = info->fake_address;
225 SvLEN(var) = 0;
226 SvCUR(var) = info->fake_length;
227 SvPOK_only_UTF8(var);
228 #if DEBUG_AS_DUAL
229 SvUV_set(var, PTR2UV(info->fake_address));
230 SvIOK_on(var);
231 SvIsUV_on(var);
232 #endif
233 }
234
235 static void
mmap_fixup(pTHX_ SV * var,struct mmap_info * info,const char * string,STRLEN len)236 mmap_fixup(pTHX_ SV* var, struct mmap_info* info, const char* string, STRLEN len) {
237 if (ckWARN(WARN_SUBSTR)) {
238 Perl_warn(aTHX_ "Writing directly to a memory mapped var is not recommended");
239 if (SvCUR(var) > info->fake_length)
240 Perl_warn(aTHX_ "Truncating new value to size of the memory map");
241 }
242
243 if (string && len)
244 Copy(string, info->fake_address, MIN(len, info->fake_length), char);
245 SV_CHECK_THINKFIRST_COW_DROP(var);
246 if (SvROK(var))
247 sv_unref_flags(var, SV_IMMEDIATE_UNREF);
248 if (SvPOK(var))
249 SvPV_free(var);
250 reset_var(aTHX_ var, info);
251 }
252
253 static int
mmap_write(pTHX_ SV * var,MAGIC * magic)254 mmap_write(pTHX_ SV* var, MAGIC* magic) {
255 struct mmap_info* info = (struct mmap_info*) magic->mg_ptr;
256 if (!SvOK(var))
257 mmap_fixup(aTHX_ var, info, NULL, 0);
258 else if (!SvPOK(var)) {
259 STRLEN len;
260 const char* string = info->isutf8 ? MySvPVutf8(var, len) : SvPV(var, len);
261 mmap_fixup(aTHX_ var, info, string, len);
262 }
263 else if (SvPVX(var) != info->fake_address)
264 mmap_fixup(aTHX_ var, info, SvPVX(var), SvCUR(var));
265 else
266 SvPOK_only_UTF8(var);
267 return 0;
268 }
269
270 static int
mmap_clear(pTHX_ SV * var,MAGIC * magic)271 mmap_clear(pTHX_ SV* var, MAGIC* magic) {
272 Perl_die(aTHX_ "Can't clear a mapped variable");
273 return 0;
274 }
275
276 static int
mmap_free(pTHX_ SV * var,MAGIC * magic)277 mmap_free(pTHX_ SV* var, MAGIC* magic) {
278 struct mmap_info* info = (struct mmap_info*) magic->mg_ptr;
279 #ifdef USE_ITHREADS
280 MUTEX_LOCK(&info->count_mutex);
281 if (--info->count == 0) {
282 COND_DESTROY(&info->cond);
283 MUTEX_DESTROY(&info->data_mutex);
284 MUTEX_UNLOCK(&info->count_mutex);
285 MUTEX_DESTROY(&info->count_mutex);
286 PerlMemShared_free(info);
287 }
288 else {
289 MUTEX_UNLOCK(&info->count_mutex);
290 }
291 #else
292 PerlMemShared_free(info);
293 #endif
294 SvREADONLY_off(var);
295 SvPV_free(var);
296 SvPVX(var) = NULL;
297 SvCUR(var) = 0;
298 return 0;
299 }
300
301 #ifdef USE_ITHREADS
302 static int
mmap_dup(pTHX_ MAGIC * magic,CLONE_PARAMS * param)303 mmap_dup(pTHX_ MAGIC* magic, CLONE_PARAMS* param)
304 {
305 struct mmap_info* info = (struct mmap_info*) magic->mg_ptr;
306 MUTEX_LOCK(&info->count_mutex);
307 assert(info->count);
308 ++info->count;
309 MUTEX_UNLOCK(&info->count_mutex);
310 return 0;
311 }
312 #else
313 #define mmap_dup 0
314 #endif
315
316 #ifdef MGf_LOCAL
317 static int
mmap_local(pTHX_ SV * var,MAGIC * magic)318 mmap_local(pTHX_ SV* var, MAGIC* magic)
319 {
320 Perl_croak(aTHX_ "Can't localize file map");
321 }
322 #define mmap_local_tail , mmap_local
323 #else
324 #define mmap_local_tail
325 #endif
326
327 static MGVTBL
328 mmap_table = { 0, mmap_write, 0, mmap_clear, mmap_free, 0, mmap_dup mmap_local_tail };
329
330 static void
check_new_variable(pTHX_ SV * var)331 check_new_variable(pTHX_ SV* var)
332 {
333 if (SvTYPE(var) > SVt_PVMG && SvTYPE(var) != SVt_PVLV)
334 Perl_croak(aTHX_ "Trying to map into a nonscalar!\n");
335 #ifdef sv_unmagicext
336 sv_unmagicext(var, PERL_MAGIC_uvar, &mmap_table);
337 #else
338 sv_unmagic(var, PERL_MAGIC_uvar);
339 #endif
340 SV_CHECK_THINKFIRST_COW_DROP(var);
341 if (SvREADONLY(var))
342 Perl_croak(aTHX_ "%s", PL_no_modify);
343 if (SvROK(var))
344 sv_unref_flags(var, SV_IMMEDIATE_UNREF);
345 if (SvNIOK(var))
346 SvNIOK_off(var);
347 if (SvPOK(var))
348 SvPV_free(var);
349 SvUPGRADE(var, SVt_PVMG);
350 }
351
352 static struct mmap_info*
initialize_mmap_info(pTHX_ void * address,size_t len,ptrdiff_t correction,int isutf8)353 initialize_mmap_info(
354 pTHX_
355 void* address,
356 size_t len,
357 ptrdiff_t correction,
358 int isutf8
359 ) {
360 struct mmap_info* info = PerlMemShared_malloc(sizeof *info);
361 info->real_address = address;
362 info->fake_address = (char*)address + correction;
363 info->real_length = len + correction;
364 info->fake_length = len;
365 #ifdef USE_ITHREADS
366 MUTEX_INIT(&info->count_mutex);
367 MUTEX_INIT(&info->data_mutex);
368 COND_INIT(&info->cond);
369 info->count = 1;
370 #endif
371 info->isutf8 = isutf8;
372 return info;
373 }
374
375 static void
add_magic(pTHX_ SV * var,struct mmap_info * info,const MGVTBL * table,int writable)376 add_magic(
377 pTHX_
378 SV* var,
379 struct mmap_info* info,
380 const MGVTBL* table,
381 int writable
382 ) {
383 MAGIC* magic = sv_magicext(var, NULL, PERL_MAGIC_uvar, table, (const char*) info, 0);
384 magic->mg_private = MMAP_MAGIC_NUMBER;
385 #ifdef MGf_LOCAL
386 magic->mg_flags |= MGf_LOCAL;
387 #endif
388 #ifdef USE_ITHREADS
389 magic->mg_flags |= MGf_DUP;
390 #endif
391 if(info->isutf8)
392 SvUTF8_on(var);
393 else
394 SvUTF8_off(var);
395 SvTAINTED_on(var);
396 if (!writable)
397 SvREADONLY_on(var);
398 }
399
400 static void
sv_setstatic(pTHX_ pMY_CXT_ SV * const sv,MDB_val * data,bool is_res)401 sv_setstatic(pTHX_ pMY_CXT_ SV *const sv, MDB_val *data, bool is_res)
402 {
403 if(ISDBDINT && !is_res)
404 sv_setiv_mg(sv, *(MyInt *)data->mv_data);
405 else {
406 const PERL_CONTEXT *cx = caller_cx(0, NULL);
407 int utf8 = LwUTF8 && !(CopHINTS_get(cx ? cx->blk_oldcop : PL_curcop) & HINT_BYTES);
408 if(utf8 && !is_utf8_string(data->mv_data, data->mv_size)) {
409 if(ckWARN(WARN_UTF8))
410 Perl_warn(aTHX_ "Malformed UTF-8 in get");
411 utf8 = 0;
412 }
413 if(LwZEROCOPY || is_res) {
414 struct mmap_info* info;
415 unsigned int eflags;
416 int writable;
417 check_new_variable(aTHX_ sv);
418 info = initialize_mmap_info(aTHX_ data->mv_data, data->mv_size, 0, utf8);
419 mdb_env_get_flags(MY_CXT.envid, &eflags);
420 writable = is_res ||
421 (F_ISSET(eflags, MDB_WRITEMAP) && !F_ISSET(MY_CXT.cflags, MDB_RDONLY));
422 add_magic(aTHX_ sv, info, &mmap_table, writable);
423 reset_var(aTHX_ sv, info);
424 } else {
425 sv_setpvn_mg(sv, data->mv_data, data->mv_size);
426 if(utf8) SvUTF8_on(sv);
427 else SvUTF8_off(sv);
428 }
429 }
430 }
431
432 /* Callback Handling */
433
434 static int
LMDB_cmp(const MDB_val * a,const MDB_val * b)435 LMDB_cmp(const MDB_val *a, const MDB_val *b) {
436 dTHX;
437 dMY_CXT;
438 dSP;
439 int ret;
440 ENTER; SAVETMPS;
441 PUSHMARK(SP);
442 sv_setpvn_mg(MY_CXT.my_asv, a->mv_data, a->mv_size);
443 sv_setpvn_mg(MY_CXT.my_bsv, b->mv_data, b->mv_size);
444 call_sv(SvRV(MY_CMP), G_SCALAR|G_NOARGS);
445 SPAGAIN;
446 ret = POPi;
447 PUTBACK;
448 FREETMPS; LEAVE;
449 return ret;
450 }
451
452 #define CvValid(rcv) (SvROK(rcv) && SvTYPE(SvRV(rcv)) == SVt_PVCV)
453
454 #define dMCOMMON \
455 dMY_CXT; \
456 int needsave = 0; \
457 SV *my_cmpsv; \
458 SV *my_dcmpsv; \
459 LMDB__Env envid
460
461
462 #define MY_PUSH_COMMON \
463 if(CvValid(my_cmpsv)) { \
464 mdb_set_compare(txn, dbi, LMDB_cmp); \
465 needsave++; \
466 } \
467 if(UNLIKELY(needsave)) { \
468 SAVESPTR(MY_CXT.my_asv); \
469 SAVESPTR(MY_CXT.my_bsv); \
470 }
471
472 #ifdef dMULTICALL
473 /* If this perl has MULTICALL support, use it for the DATA comparer */
474 #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
475 #define FIXREFCOUNT if(CvDEPTH(multicall_cv) > 1) \
476 SvREFCNT_inc_simple_void_NN(multicall_cv)
477 #else
478 #define FIXREFCOUNT
479 #endif
480 #if PERL_VERSION < 23 || (PERL_VERSION == 23 && PERL_SUBVERSION < 8)
481 #define MY_POP_MULTICALL \
482 if(multicall_cv) { \
483 FIXREFCOUNT; \
484 POP_MULTICALL; \
485 newsp = newsp; \
486 }
487 #define MYMCINIT multicall_cv = NULL
488 #else
489 #define MY_POP_MULTICALL if(multicall_cop) { POP_MULTICALL; }
490 #if PERL_VERSION == 23 && PERL_SUBVERSION == 8
491 #define MYMCINIT multicall_oldcatch = 0
492 #else
493 #define MYMCINIT
494 #endif
495 #endif
496
497 static int
LMDB_dcmp(const MDB_val * a,const MDB_val * b)498 LMDB_dcmp(const MDB_val *a, const MDB_val *b) {
499 dTHX;
500 dMY_CXT;
501 sv_setpvn_mg(MY_CXT.my_asv, a->mv_data, a->mv_size);
502 sv_setpvn_mg(MY_CXT.my_bsv, b->mv_data, b->mv_size);
503 PL_op = MY_CXT.lmdb_dcmp_cop;
504 CALLRUNOPS(aTHX);
505 return SvIV(*PL_stack_sp);
506 }
507
508
509 #define dMY_MULTICALL \
510 dMCOMMON; \
511 dMULTICALL; \
512 multicall_cop = NULL; \
513 I32 gimme = G_SCALAR
514
515 #define MY_PUSH_MULTICALL \
516 MYMCINIT; \
517 if(CvValid(my_dcmpsv)) { \
518 PUSH_MULTICALL((CV *)SvRV(my_dcmpsv)); \
519 MY_CXT.lmdb_dcmp_cop = multicall_cop; \
520 mdb_set_dupsort(txn, dbi, LMDB_dcmp); \
521 needsave++; \
522 } \
523 MY_PUSH_COMMON
524
525
526 #else /* NO MULTICALL support, use a slow path */
527
528 static int
LMDB_dcmp(const MDB_val * a,const MDB_val * b)529 LMDB_dcmp(const MDB_val *a, const MDB_val *b) {
530 dTHX;
531 dMY_CXT;
532 dSP;
533 int ret;
534 ENTER; SAVETMPS;
535 PUSHMARK(SP);
536 sv_setpvn_mg(MY_CXT.my_asv, a->mv_data, a->mv_size);
537 sv_setpvn_mg(MY_CXT.my_bsv, b->mv_data, b->mv_size);
538 call_sv(SvRV(MY_DCMP), G_SCALAR|G_NOARGS);
539 SPAGAIN;
540 ret = POPi;
541 PUTBACK;
542 FREETMPS; LEAVE;
543 return ret;
544 }
545
546 #define dMY_MULTICALL dMCOMMON
547
548 #define MY_PUSH_MULTICALL \
549 if(CvValid(my_dcmpsv)) { \
550 mdb_set_dupsort(txn, dbi, LMDB_dcmp); \
551 needsave++; \
552 } \
553 MY_PUSH_COMMON
554
555 #define MY_POP_MULTICALL
556
557 #endif /* dMULTICALL */
558
559 /* Error Handling */
560 #define DieOnErrSV GvSV(gv_fetchpv("LMDB_File::die_on_err", 0, SVt_IV))
561 #define DieOnErr SvTRUEx(DieOnErrSV)
562
563 #define LastErrSV GvSV(gv_fetchpv("LMDB_File::last_err", 0, SVt_IV))
564
565 #define ProcError(res) \
566 if(UNLIKELY(res)) { \
567 sv_setiv(LastErrSV, res); \
568 sv_setpv(ERRSV, mdb_strerror(res)); \
569 if(DieOnErr) croak(NULL); \
570 XSRETURN_IV(res); \
571 }
572
573 MODULE = LMDB_File PACKAGE = LMDB::Env PREFIX = mdb_env_
574
575 int
576 mdb_env_create(env)
577 LMDB::Env &env = NO_INIT
578 POSTCALL:
579 ProcError(RETVAL);
580 OUTPUT:
581 env
582
583 int
584 mdb_env_open(env, path, flags, mode)
585 LMDB::Env env
586 const char * path
587 flags_t flags
588 int mode
589 PREINIT:
590 dMY_CXT;
591 AV* av;
592 SV* eidx;
593 POSTCALL:
594 ProcError(RETVAL);
595 eidx = sv_2mortal(newSVuv(PTR2UV(MY_CXT.envid = env)));
596 av = newAV();
597 av_store(av, 0, newRV_noinc((SV *)newAV())); /* Txns */
598 av_store(av, 1, newRV_noinc((SV *)(MY_CXT.DCmps = newAV())));
599 av_store(av, 2, newRV_noinc((SV *)(MY_CXT.Cmps = newAV())));
600 av_store(av, 3, (MY_CXT.OFlags = newSVpv("",0))); /* FastMode */
601 hv_store_ent(get_hv("LMDB::Env::Envs", 0), eidx, newRV_noinc((SV *)av), 0);
602
603 int
604 mdb_env_copy(env, path, flags = 0)
605 LMDB::Env env
606 const char * path
607 unsigned flags
608 CODE:
609 #if MDB_VERSION_PATCH < 14
610 if(flags) croak("LMDB_File::copy: This version don't support flags");
611 RETVAL = mdb_env_copy(env, path);
612 #else
613 RETVAL = mdb_env_copy2(env, path, flags);
614 #endif
615 ProcError(RETVAL);
616 OUTPUT:
617 RETVAL
618
619 int
620 mdb_env_copyfd(env, fd, flags = 0)
621 LMDB::Env env
622 mdb_filehandle_t fd
623 unsigned flags
624 CODE:
625 #if MDB_VERSION_PATCH < 14
626 if(flags) croak("LMDB_File::copyfd: This version don't support flags");
627 RETVAL = mdb_env_copyfd(env, fd);
628 #else
629 RETVAL = mdb_env_copyfd2(env, fd, flags);
630 #endif
631 ProcError(RETVAL);
632 OUTPUT:
633 RETVAL
634
635 HV*
636 mdb_env_stat(env)
637 LMDB::Env env
638 PREINIT:
639 MDB_stat stat;
640 CODE:
641 populateStat(aTHX_ &RETVAL, mdb_env_stat(env, &stat), &stat);
642 OUTPUT:
643 RETVAL
644
645 HV*
646 mdb_env_info(env)
647 LMDB::Env env
648 PREINIT:
649 MDB_envinfo stat;
650 int res;
651 CODE:
652 res = mdb_env_info(env, &stat);
653 ProcError(res);
654 RETVAL = newHV();
655 StoreUV("mapaddr", (uintptr_t)stat.me_mapaddr);
656 StoreUV("mapsize", stat.me_mapsize);
657 StoreUV("last_pgno", stat.me_last_pgno);
658 StoreUV("last_txnid", stat.me_last_txnid);
659 StoreUV("maxreaders", stat.me_maxreaders);
660 StoreUV("numreaders", stat.me_numreaders);
661 OUTPUT:
662 RETVAL
663
664 int
665 mdb_env_sync(env, force=0)
666 LMDB::Env env
667 int force
668
669 void
670 mdb_env_close(env)
671 LMDB::Env env
672 PREINIT:
673 dMY_CXT;
674 SV *eidx;
675 POSTCALL:
676 eidx = sv_2mortal(newSVuv(PTR2UV(env)));
677 MY_CXT.envid = (LMDB__Env)hv_delete_ent(
678 get_hv("LMDB::Env::Envs", 0), eidx, G_DISCARD, 0
679 );
680
681 int
682 mdb_env_set_flags(env, flags, onoff)
683 LMDB::Env env
684 unsigned int flags
685 int onoff
686
687 #define CHANGEABLE (MDB_NOSYNC|MDB_NOMETASYNC|MDB_MAPASYNC|MDB_NOMEMINIT)
688 #define CHANGELESS (MDB_FIXEDMAP|MDB_NOSUBDIR|MDB_RDONLY| \
689 MDB_WRITEMAP|MDB_NOTLS|MDB_NOLOCK|MDB_NORDAHEAD)
690
691 int
692 mdb_env_get_flags(env, flags)
693 LMDB::Env env
694 unsigned int &flags = NO_INIT
695 POSTCALL:
696 flags &= (CHANGEABLE|CHANGELESS);
697 OUTPUT:
698 flags
699
700 int
701 mdb_env_get_path(env, path)
702 LMDB::Env env
703 const char * &path = NO_INIT
704 OUTPUT:
705 path
706
707 int
708 mdb_env_set_mapsize(env, size)
709 LMDB::Env env
710 size_t size
711 POSTCALL:
712 ProcError(RETVAL);
713
714 int
715 mdb_env_set_maxreaders(env, readers)
716 LMDB::Env env
717 unsigned int readers
718 POSTCALL:
719 ProcError(RETVAL);
720
721 int
722 mdb_env_get_maxreaders(env, readers)
723 LMDB::Env env
724 unsigned int &readers = NO_INIT
725 OUTPUT:
726 readers
727 POSTCALL:
728 ProcError(RETVAL);
729
730 int
731 mdb_env_set_maxdbs(env, dbs)
732 LMDB::Env env
733 int dbs
734 POSTCALL:
735 ProcError(RETVAL);
736
737 int
738 mdb_env_get_maxkeysize(env)
739 LMDB::Env env
740
741 UV
742 mdb_env_id(env)
743 LMDB::Env env
744 CODE:
745 RETVAL = PTR2UV(env);
746 OUTPUT:
747 RETVAL
748
749 void
750 _clone()
751 CODE:
752 MY_CXT_CLONE;
753 MY_CXT.envid = NULL;
754 MY_CXT.curdb = 0;
755 MY_CXT.my_asv = get_sv("::a", GV_ADDMULTI);
756 MY_CXT.my_bsv = get_sv("::b", GV_ADDMULTI);
757
758 BOOT:
759 MY_CXT_INIT;
760 MY_CXT.my_asv = get_sv("::a", GV_ADDMULTI);
761 MY_CXT.my_bsv = get_sv("::b", GV_ADDMULTI);
762
763
764 MODULE = LMDB_File PACKAGE = LMDB::Txn PREFIX = mdb_txn
765
766 int
767 mdb_txn_begin(env, parent, flags, txn)
768 LMDB::Env env
769 TxnOrNull parent
770 flags_t flags
771 LMDB::Txn &txn = NO_INIT
772 POSTCALL:
773 ProcError(RETVAL);
774 OUTPUT:
775 txn
776
777 UV
778 mdb_txn_env(txn)
779 LMDB::Txn txn
780 CODE:
781 RETVAL= PTR2UV(mdb_txn_env(txn));
782 OUTPUT:
783 RETVAL
784
785 int
786 mdb_txn_commit(txn)
787 LMDB::Txn txn
788 POSTCALL:
789 ProcError(RETVAL);
790
791 void
792 mdb_txn_abort(txn)
793 LMDB::Txn txn
794
795 void
796 mdb_txn_reset(txn)
797 LMDB::Txn txn
798
799 int
800 mdb_txn_renew(txn)
801 LMDB::Txn txn
802 POSTCALL:
803 ProcError(RETVAL);
804
805 UV
806 mdb_txn_id(txn)
807 LMDB::Txn txn
808 CODE:
809 RETVAL = PTR2UV(txn);
810 OUTPUT:
811 RETVAL
812
813 MODULE = LMDB_File PACKAGE = LMDB::Txn PREFIX = mdb_txn_
814
815 #if MDB_VERSION_FULL > MDB_VERINT(0,9,14)
816 size_t
817 mdb_txn_id(txn)
818 LMDB::Txn txn
819
820 #endif
821
822 MODULE = LMDB_File PACKAGE = LMDB::Txn PREFIX = mdb
823
824 int
825 mdb_dbi_open(txn, name, flags, dbi)
826 LMDB::Txn txn
827 const char * name = SvOK($arg) ? (const char *)SvPV_nolen($arg) : NULL;
828 flags_t flags
829 LMDB &dbi = NO_INIT
830 PREINIT:
831 dMY_CXT;
832 POSTCALL:
833 ProcError(RETVAL);
834 mdb_dbi_flags(txn, dbi, &MY_CXT.cflags);
835 MY_CXT.cflags |= LMDB_OFLAGS;
836 MY_CXT.curdb = dbi;
837 OUTPUT:
838 dbi
839
840 MODULE = LMDB_File PACKAGE = LMDB::Cursor PREFIX = mdb_cursor_
841
842 int
843 mdb_cursor_open(txn, dbi, cursor)
844 LMDB::Txn txn
845 LMDB dbi
846 LMDB::Cursor &cursor = NO_INIT
847 OUTPUT:
848 cursor
849
850 void
851 mdb_cursor_close(cursor)
852 LMDB::Cursor cursor
853
854 int
855 mdb_cursor_count(cursor, count)
856 LMDB::Cursor cursor
857 UV &count = NO_INIT
858 OUTPUT:
859 count
860
861 int
862 mdb_cursor_dbi(cursor)
863 LMDB::Cursor cursor
864
865 int
866 mdb_cursor_renew(txn, cursor)
867 LMDB::Txn txn
868 LMDB::Cursor cursor
869
870 UV
871 mdb_cursor_txn(cursor)
872 LMDB::Cursor cursor
873 CODE:
874 RETVAL = PTR2UV(mdb_cursor_txn(cursor));
875 OUTPUT:
876 RETVAL
877
878 MODULE = LMDB_File PACKAGE = LMDB::Cursor PREFIX = mdb_cursor
879
880 int
881 mdb_cursor_get(cursor, key, data, op = MDB_NEXT)
882 PREINIT:
883 dMY_MULTICALL;
884 dCURSOR;
885 INPUT:
886 LMDB::Cursor cursor +PREC_FLGS($var);
887 DBKC &key
888 DBD &data
889 MDB_cursor_op op
890 INIT:
891 MY_PUSH_MULTICALL;
892 POSTCALL:
893 MY_POP_MULTICALL;
894 ProcError(RETVAL);
895 OUTPUT:
896 key
897 data
898
899 int
900 mdb_cursor_put(cursor, key, data, flags = 0, ...)
901 PREINIT:
902 dMY_MULTICALL;
903 dCURSOR;
904 INPUT:
905 LMDB::Cursor cursor +PREC_FLGS($var);
906 DBKC &key
907 DBD &data = NO_INIT
908 flags_t flags
909 INIT:
910 if(flags & MDB_RESERVE) {
911 size_t res_size;
912 size_t max_size = F_ISSET(MY_CXT.cflags, MDB_DUPSORT)
913 ? mdb_env_get_maxkeysize(envid)
914 : 0xffffffff;
915 if(items != 5)
916 croak("%s: MDB_RESERVE needs a length argument (1 .. %d)",
917 "LMDB_File::_put", max_size);
918 res_size = SvUV(ST(5));
919 if(res_size == 0)
920 croak("%s: MDB_RESERVE length must be > 0",
921 "LMDB_File::_put");
922 if(ISDBDINT && res_size != sizeof(MyInt))
923 croak("%s: MDB_RESERVE with MDB_INTEGERDUP length should be %d",
924 "LMDB_File::_put", sizeof(MyInt));
925 if(res_size > max_size)
926 croak("%s: MDB_RESERVE length should be <= %d", max_size);
927 data.mv_size = res_size;
928 data.mv_data = NULL;
929 } else {
930 /* Normal initialization */
931 Sv2DBD(ST(2), data);
932 }
933 MY_PUSH_MULTICALL;
934 POSTCALL:
935 MY_POP_MULTICALL;
936 if((flags & MDB_NOOVERWRITE) && RETVAL == MDB_KEYEXIST) {
937 sv_setstatic(aTHX_ aMY_CXT_ ST(2), &data, 0);
938 SvSETMAGIC(ST(2));
939 }
940 ProcError(RETVAL);
941 if(flags & MDB_RESERVE) {
942 sv_setstatic(aTHX_ aMY_CXT_ ST(2), &data, 1);
943 SvSETMAGIC(ST(2));
944 }
945
946 int
947 mdb_cursor_del(cursor, flags = 0)
948 PREINIT:
949 dMY_MULTICALL;
950 dCURSOR;
951 INPUT:
952 LMDB::Cursor cursor +PREC_FLGS($var);
953 flags_t flags
954 INIT:
955 MY_PUSH_MULTICALL;
956 POSTCALL:
957 MY_POP_MULTICALL;
958 ProcError(RETVAL);
959
960 MODULE = LMDB_File PACKAGE = LMDB_File PREFIX = mdb
961
962 #ifdef __GNUC__
963 #pragma GCC diagnostic ignored "-Wmaybe-uninitialized"
964 #endif
965
966 INCLUDE: const-xs.inc
967
968 #ifdef __GNUC__
969 #pragma GCC diagnostic warning "-Wmaybe-uninitialized"
970 #endif
971
972 HV*
973 mdb_stat(txn, dbi)
974 LMDB::Txn txn
975 LMDB dbi
976 PREINIT:
977 MDB_stat stat;
978 CODE:
979 populateStat(aTHX_ &RETVAL, mdb_stat(txn, dbi, &stat), &stat);
980 OUTPUT:
981 RETVAL
982
983 int
984 mdb_dbi_flags(txn, dbi, flags)
985 LMDB::Txn txn
986 LMDB dbi
987 unsigned int &flags = NO_INIT
988 POSTCALL:
989 ProcError(RETVAL);
990 OUTPUT:
991 RETVAL
992 flags
993
994 void
995 mdb_dbi_close(env, dbi)
996 LMDB::Env env
997 LMDB dbi
998
999 int
1000 mdb_drop(txn, dbi, del)
1001 LMDB::Txn txn
1002 LMDB dbi
1003 int del
1004 POSTCALL:
1005 ProcError(RETVAL);
1006
1007 =pod
1008 int
1009 mdb_set_compare(txn, dbi, cmp)
1010 LMDB::Txn txn
1011 LMDB dbi
1012 MDB_cmp_func * cmp
1013
1014 int
1015 mdb_set_dupsort(txn, dbi, cmp)
1016 LMDB::Txn txn
1017 LMDB dbi
1018 MDB_cmp_func * cmp
1019
1020 int
1021 mdb_set_relfunc(txn, dbi, rel)
1022 LMDB::Txn txn
1023 LMDB dbi
1024 MDB_rel_func * rel
1025
1026 int
1027 mdb_set_relctx(txn, dbi, ctx)
1028 LMDB::Txn txn
1029 LMDB dbi
1030 void * ctx
1031 =cut
1032
1033 int
1034 mdb_get(txn, dbi, key, data)
1035 PREINIT:
1036 dMY_MULTICALL;
1037 INPUT:
1038 LMDB::Txn txn +CHECK_ALLCUR;
1039 LMDB dbi
1040 DBK &key
1041 DBD &data = NO_INIT
1042 INIT:
1043 MY_PUSH_MULTICALL;
1044 POSTCALL:
1045 MY_POP_MULTICALL;
1046 ProcError(RETVAL);
1047 OUTPUT:
1048 data
1049
1050 int
1051 mdb_put(txn, dbi, key, data, flags = 0, ...)
1052 PREINIT:
1053 dMY_MULTICALL;
1054 INPUT:
1055 LMDB::Txn txn +CHECK_ALLCUR;
1056 LMDB dbi
1057 DBK &key
1058 DBD &data = NO_INIT
1059 flags_t flags
1060 INIT:
1061 if(flags & MDB_RESERVE) {
1062 size_t res_size;
1063 size_t max_size = F_ISSET(MY_CXT.cflags, MDB_DUPSORT)
1064 ? mdb_env_get_maxkeysize(envid)
1065 : 0xffffffff;
1066 if(items != 6)
1067 croak("%s: MDB_RESERVE needs a length argument (1 .. %d)",
1068 "LMDB_File::_put", max_size);
1069 res_size = SvUV(ST(5));
1070 if(res_size == 0)
1071 croak("%s: MDB_RESERVE length must be > 0",
1072 "LMDB_File::_put");
1073 if(ISDBDINT && res_size != sizeof(MyInt))
1074 croak("%s: MDB_RESERVE with MDB_INTEGERDUP length should be %d",
1075 "LMDB_File::_put", sizeof(MyInt));
1076 if(res_size > max_size)
1077 croak("%s: MDB_RESERVE length should be <= %d", max_size);
1078 data.mv_size = res_size;
1079 data.mv_data = NULL;
1080 } else {
1081 /* Normal initialization */
1082 Sv2DBD(ST(3), data);
1083 }
1084 MY_PUSH_MULTICALL;
1085 POSTCALL:
1086 MY_POP_MULTICALL;
1087 if((flags & MDB_NOOVERWRITE) && RETVAL == MDB_KEYEXIST) {
1088 sv_setstatic(aTHX_ aMY_CXT_ ST(3), &data, 0);
1089 SvSETMAGIC(ST(3));
1090 }
1091 ProcError(RETVAL);
1092 if(flags & MDB_RESERVE) {
1093 sv_setstatic(aTHX_ aMY_CXT_ ST(3), &data, 1);
1094 SvSETMAGIC(ST(3));
1095 }
1096
1097 int
1098 mdb_del(txn, dbi, key, data)
1099 PREINIT:
1100 dMY_MULTICALL;
1101 INPUT:
1102 LMDB::Txn txn +CHECK_ALLCUR;
1103 LMDB dbi
1104 DBK &key
1105 DBD &data
1106 INIT:
1107 MY_PUSH_MULTICALL;
1108 CODE:
1109 RETVAL = mdb_del(txn, dbi, &key, (SvOK(ST(3)) ? &data : NULL));
1110 MY_POP_MULTICALL;
1111 ProcError(RETVAL);
1112 OUTPUT:
1113 RETVAL
1114
1115 int
1116 mdb_cmp(txn, dbi, a, b)
1117 PREINIT:
1118 dMY_MULTICALL;
1119 INPUT:
1120 LMDB::Txn txn +CHECK_ALLCUR;
1121 LMDB dbi
1122 DBD &a
1123 DBD &b
1124 INIT:
1125 MY_PUSH_MULTICALL;
1126 POSTCALL:
1127 MY_POP_MULTICALL;
1128
1129 int
1130 mdb_dcmp(txn, dbi, a, b)
1131 PREINIT:
1132 dMY_MULTICALL;
1133 INPUT:
1134 LMDB::Txn txn +CHECK_ALLCUR;
1135 LMDB dbi
1136 DBD &a
1137 DBD &b
1138 INIT:
1139 MY_PUSH_MULTICALL;
1140 POSTCALL:
1141 MY_POP_MULTICALL;
1142
1143 MODULE = LMDB_File PACKAGE = LMDB_File PREFIX = mdb_
1144
1145 =pod
1146 int
1147 mdb_reader_list(env, func, ctx)
1148 LMDB::Env env
1149 MDB_msg_func * func
1150 void * ctx
1151 =cut
1152
1153 void
1154 _resetcurdbi()
1155 CODE:
1156 dMY_CXT;
1157 MY_CXT.curdb = 0;
1158
1159 int
1160 mdb_reader_check(env, dead)
1161 LMDB::Env env
1162 int &dead
1163 OUTPUT:
1164 dead
1165
1166 char *
1167 mdb_strerror(err)
1168 int err
1169
1170 char *
1171 mdb_version(major, minor, patch)
1172 int &major = NO_INIT
1173 int &minor = NO_INIT
1174 int &patch = NO_INIT
1175 OUTPUT:
1176 major
1177 minor
1178 patch
1179