1 /*
2
3 BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2, 3 & 4
4
5 written by Paul Marquess <pmqs@cpan.org>
6
7 All comments/suggestions/problems are welcome
8
9 Copyright (c) 1997-2011 Paul Marquess. All rights reserved.
10 This program is free software; you can redistribute it and/or
11 modify it under the same terms as Perl itself.
12
13 Please refer to the COPYRIGHT section in
14
15 Changes:
16 0.01 - First Alpha Release
17 0.02 -
18
19 */
20
21
22
23 #ifdef __cplusplus
24 extern "C" {
25 #endif
26
27 #define PERL_POLLUTE
28 #include "EXTERN.h"
29 #include "perl.h"
30 #include "XSUB.h"
31 #include "ppport.h"
32
33
34 /* XSUB.h defines a macro called abort */
35 /* This clashes with the txn abort method in Berkeley DB 4.x */
36 /* This is a problem with ActivePerl (at least) */
37
38 #ifdef _WIN32
39 # ifdef abort
40 # undef abort
41 # endif
42 # ifdef fopen
43 # undef fopen
44 # endif
45 # ifdef fclose
46 # undef fclose
47 # endif
48 # ifdef rename
49 # undef rename
50 # endif
51 # ifdef open
52 # undef open
53 # endif
54 #endif
55
56 #ifndef SvUTF8_off
57 # define SvUTF8_off(x)
58 #endif
59
60 /* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
61 * shortly #included by the <db.h>) __attribute__ to the possibly
62 * already defined __attribute__, for example by GNUC or by Perl. */
63
64 #undef __attribute__
65
66 #ifdef USE_PERLIO
67 # define GetFILEptr(sv) PerlIO_findFILE(IoIFP(sv_2io(sv)))
68 #else
69 # define GetFILEptr(sv) IoIFP(sv_2io(sv))
70 #endif
71
72 #include <db.h>
73
74 /* Check the version of Berkeley DB */
75
76 #ifndef DB_VERSION_MAJOR
77 #ifdef HASHMAGIC
78 #error db.h is from Berkeley DB 1.x - need at least Berkeley DB 2.6.4
79 #else
80 #error db.h is not for Berkeley DB at all.
81 #endif
82 #endif
83
84 #if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6) ||\
85 (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 6 && DB_VERSION_PATCH < 4)
86 # error db.h is from Berkeley DB 2.0-2.5 - need at least Berkeley DB 2.6.4
87 #endif
88
89
90 #if (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0)
91 # define IS_DB_3_0_x
92 #endif
93
94 #if DB_VERSION_MAJOR >= 3
95 # define AT_LEAST_DB_3
96 #endif
97
98 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 1)
99 # define AT_LEAST_DB_3_1
100 #endif
101
102 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2)
103 # define AT_LEAST_DB_3_2
104 #endif
105
106 #if DB_VERSION_MAJOR > 3 || \
107 (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 2) ||\
108 (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 2 && DB_VERSION_PATCH >= 6)
109 # define AT_LEAST_DB_3_2_6
110 #endif
111
112 #if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3)
113 # define AT_LEAST_DB_3_3
114 #endif
115
116 #if DB_VERSION_MAJOR >= 4
117 # define AT_LEAST_DB_4
118 #endif
119
120 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
121 # define AT_LEAST_DB_4_1
122 #endif
123
124 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 2)
125 # define AT_LEAST_DB_4_2
126 #endif
127
128 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
129 # define AT_LEAST_DB_4_3
130 #endif
131
132 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 4)
133 # define AT_LEAST_DB_4_4
134 #endif
135
136 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 5)
137 # define AT_LEAST_DB_4_5
138 #endif
139
140 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 6)
141 # define AT_LEAST_DB_4_6
142 #endif
143
144 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 7)
145 # define AT_LEAST_DB_4_7
146 #endif
147
148 #if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 8)
149 # define AT_LEAST_DB_4_8
150 #endif
151
152 #if DB_VERSION_MAJOR > 5 || (DB_VERSION_MAJOR == 5 && DB_VERSION_MINOR >= 1)
153 # define AT_LEAST_DB_5_1
154 #endif
155
156 #if DB_VERSION_MAJOR > 5 || (DB_VERSION_MAJOR == 5 && DB_VERSION_MINOR >= 2)
157 # define AT_LEAST_DB_5_2
158 #endif
159
160 #if DB_VERSION_MAJOR > 5 || (DB_VERSION_MAJOR == 5 && DB_VERSION_MINOR >= 3)
161 # define AT_LEAST_DB_5_3
162 #endif
163
164 #ifdef __cplusplus
165 }
166 #endif
167
168 #define DBM_FILTERING
169 #define STRICT_CLOSE
170 /* #define ALLOW_RECNO_OFFSET */
171 /* #define TRACE */
172
173 #if DB_VERSION_MAJOR == 2 && ! defined(DB_LOCK_DEADLOCK)
174 # define DB_LOCK_DEADLOCK EAGAIN
175 #endif /* DB_VERSION_MAJOR == 2 */
176
177 #if DB_VERSION_MAJOR == 2
178 # define DB_QUEUE 4
179 #endif /* DB_VERSION_MAJOR == 2 */
180
181 #if DB_VERSION_MAJOR == 2
182 # define BackRef internal
183 #else
184 # if DB_VERSION_MAJOR == 3 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0)
185 # define BackRef cj_internal
186 # else
187 # define BackRef api_internal
188 # endif
189 #endif
190
191 #ifdef AT_LEAST_DB_3_2
192 # define DB_callback DB * db,
193 #else
194 # define DB_callback
195 #endif
196
197 #if DB_VERSION_MAJOR > 2
198 typedef struct {
199 int db_lorder;
200 size_t db_cachesize;
201 size_t db_pagesize;
202
203
204 void *(*db_malloc) __P((size_t));
205 int (*dup_compare)
206 __P((DB_callback const DBT *, const DBT *));
207
208 u_int32_t bt_maxkey;
209 u_int32_t bt_minkey;
210 int (*bt_compare)
211 __P((DB_callback const DBT *, const DBT *));
212 size_t (*bt_prefix)
213 __P((DB_callback const DBT *, const DBT *));
214
215 u_int32_t h_ffactor;
216 u_int32_t h_nelem;
217 u_int32_t (*h_hash)
218 __P((DB_callback const void *, u_int32_t));
219
220 int re_pad;
221 int re_delim;
222 u_int32_t re_len;
223 char *re_source;
224
225 #define DB_DELIMITER 0x0001
226 #define DB_FIXEDLEN 0x0008
227 #define DB_PAD 0x0010
228 u_int32_t flags;
229 u_int32_t q_extentsize;
230
231 u_int32_t heapsize_gbytes;
232 u_int32_t heapsize_bytes;
233 } DB_INFO ;
234
235 #endif /* DB_VERSION_MAJOR > 2 */
236
237 typedef struct {
238 int Status ;
239 /* char ErrBuff[1000] ; */
240 SV * ErrPrefix ;
241 SV * ErrHandle ;
242 #ifdef AT_LEAST_DB_4_3
243 SV * MsgHandle ;
244 #endif
245 DB_ENV * Env ;
246 int open_dbs ;
247 int TxnMgrStatus ;
248 int active ;
249 bool txn_enabled ;
250 bool opened ;
251 bool cds_enabled;
252 } BerkeleyDB_ENV_type ;
253
254
255 typedef struct {
256 DBTYPE type ;
257 bool recno_or_queue ;
258 char * filename ;
259 BerkeleyDB_ENV_type * parent_env ;
260 DB * dbp ;
261 SV * compare ;
262 bool in_compare ;
263 SV * dup_compare ;
264 bool in_dup_compare ;
265 SV * prefix ;
266 bool in_prefix ;
267 SV * hash ;
268 bool in_hash ;
269 #ifdef AT_LEAST_DB_3_3
270 SV * associated ;
271 bool secondary_db ;
272 #endif
273 #ifdef AT_LEAST_DB_4_8
274 SV * associated_foreign ;
275 SV * bt_compress ;
276 SV * bt_uncompress ;
277 #endif
278 bool primary_recno_or_queue ;
279 int Status ;
280 DB_INFO * info ;
281 DBC * cursor ;
282 DB_TXN * txn ;
283 int open_cursors ;
284 #ifdef AT_LEAST_DB_4_3
285 int open_sequences ;
286 #endif
287 u_int32_t partial ;
288 u_int32_t dlen ;
289 u_int32_t doff ;
290 int active ;
291 bool cds_enabled;
292 #ifdef ALLOW_RECNO_OFFSET
293 int array_base ;
294 #endif
295 #ifdef DBM_FILTERING
296 SV * filter_fetch_key ;
297 SV * filter_store_key ;
298 SV * filter_fetch_value ;
299 SV * filter_store_value ;
300 int filtering ;
301 #endif
302 } BerkeleyDB_type;
303
304
305 typedef struct {
306 DBTYPE type ;
307 bool recno_or_queue ;
308 char * filename ;
309 DB * dbp ;
310 SV * compare ;
311 SV * dup_compare ;
312 SV * prefix ;
313 SV * hash ;
314 #ifdef AT_LEAST_DB_3_3
315 SV * associated ;
316 bool secondary_db ;
317 #endif
318 #ifdef AT_LEAST_DB_4_8
319 SV * associated_foreign ;
320 #endif
321 bool primary_recno_or_queue ;
322 int Status ;
323 DB_INFO * info ;
324 DBC * cursor ;
325 DB_TXN * txn ;
326 BerkeleyDB_type * parent_db ;
327 u_int32_t partial ;
328 u_int32_t dlen ;
329 u_int32_t doff ;
330 int active ;
331 bool cds_enabled;
332 #ifdef ALLOW_RECNO_OFFSET
333 int array_base ;
334 #endif
335 #ifdef DBM_FILTERING
336 SV * filter_fetch_key ;
337 SV * filter_store_key ;
338 SV * filter_fetch_value ;
339 SV * filter_store_value ;
340 int filtering ;
341 #endif
342 } BerkeleyDB_Cursor_type;
343
344 typedef struct {
345 BerkeleyDB_ENV_type * env ;
346 } BerkeleyDB_TxnMgr_type ;
347
348 #if 1
349 typedef struct {
350 int Status ;
351 DB_TXN * txn ;
352 int active ;
353 } BerkeleyDB_Txn_type ;
354 #else
355 typedef DB_TXN BerkeleyDB_Txn_type ;
356 #endif
357
358 #ifdef AT_LEAST_DB_4_3
359 typedef struct {
360 int active;
361 BerkeleyDB_type *db;
362 DB_SEQUENCE *seq;
363 } BerkeleyDB_Sequence_type;
364 #else
365 typedef int BerkeleyDB_Sequence_type;
366 typedef SV* db_seq_t;
367 #endif
368
369
370 typedef BerkeleyDB_ENV_type * BerkeleyDB__Env ;
371 typedef BerkeleyDB_ENV_type * BerkeleyDB__Env__Raw ;
372 typedef BerkeleyDB_ENV_type * BerkeleyDB__Env__Inner ;
373 typedef BerkeleyDB_type * BerkeleyDB ;
374 typedef void * BerkeleyDB__Raw ;
375 typedef BerkeleyDB_type * BerkeleyDB__Common ;
376 typedef BerkeleyDB_type * BerkeleyDB__Common__Raw ;
377 typedef BerkeleyDB_type * BerkeleyDB__Common__Inner ;
378 typedef BerkeleyDB_type * BerkeleyDB__Hash ;
379 typedef BerkeleyDB_type * BerkeleyDB__Hash__Raw ;
380 typedef BerkeleyDB_type * BerkeleyDB__Btree ;
381 typedef BerkeleyDB_type * BerkeleyDB__Btree__Raw ;
382 typedef BerkeleyDB_type * BerkeleyDB__Recno ;
383 typedef BerkeleyDB_type * BerkeleyDB__Recno__Raw ;
384 typedef BerkeleyDB_type * BerkeleyDB__Queue ;
385 typedef BerkeleyDB_type * BerkeleyDB__Queue__Raw ;
386 typedef BerkeleyDB_type * BerkeleyDB__Heap ;
387 typedef BerkeleyDB_type * BerkeleyDB__Heap__Raw ;
388 typedef BerkeleyDB_Cursor_type BerkeleyDB__Cursor_type ;
389 typedef BerkeleyDB_Cursor_type * BerkeleyDB__Cursor ;
390 typedef BerkeleyDB_Cursor_type * BerkeleyDB__Cursor__Raw ;
391 typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr ;
392 typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Raw ;
393 typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Inner ;
394 typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn ;
395 typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn__Raw ;
396 typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn__Inner ;
397 #ifdef AT_LEAST_DB_4_3
398 typedef BerkeleyDB_Sequence_type * BerkeleyDB__Sequence ;
399 #else
400 typedef int * BerkeleyDB__Sequence ;
401 #endif
402 #if 0
403 typedef DB_LOG * BerkeleyDB__Log ;
404 typedef DB_LOCKTAB * BerkeleyDB__Lock ;
405 #endif
406 typedef DBT DBTKEY ;
407 typedef DBT DBT_OPT ;
408 typedef DBT DBT_B ;
409 typedef DBT DBTKEY_B ;
410 typedef DBT DBTKEY_Br ;
411 typedef DBT DBTKEY_Bpr ;
412 typedef DBT DBTKEY_seq ;
413 typedef DBT DBTVALUE ;
414 typedef void * PV_or_NULL ;
415 typedef PerlIO * IO_or_NULL ;
416 typedef int DualType ;
417 typedef SV SVnull;
418
419 static void
420 hash_delete(char * hash, char * key);
421
422 #ifdef TRACE
423 # define Trace(x) (printf("# "), printf x)
424 #else
425 # define Trace(x)
426 #endif
427
428 #ifdef ALLOW_RECNO_OFFSET
429 # define RECNO_BASE db->array_base
430 #else
431 # define RECNO_BASE 1
432 #endif
433
434 #if DB_VERSION_MAJOR == 2
435 # define flagSet_DB2(i, f) i |= f
436 #else
437 # define flagSet_DB2(i, f)
438 #endif
439
440 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
441 # define flagSet(bitmask) (flags & (bitmask))
442 #else
443 # define flagSet(bitmask) ((flags & DB_OPFLAGS_MASK) == (bitmask))
444 #endif
445
446 #ifdef DB_GET_BOTH_RANGE
447 # define flagSetBoth() (flagSet(DB_GET_BOTH) || flagSet(DB_GET_BOTH_RANGE))
448 #else
449 # define flagSetBoth() (flagSet(DB_GET_BOTH))
450 #endif
451
452 #ifndef AT_LEAST_DB_4
453 typedef int db_timeout_t ;
454 #endif
455
456 #ifdef AT_LEAST_DB_5_2
457
458 # define isHeapDb(db) ((db)->type == DB_HEAP)
459 #else
460 # define isHeapDb(db) (0)
461
462 int __heap_exist __P((void));
463 # define DB_HEAP_RID_SZ 1
464
465
466 #endif
467
468 #define ERR_BUFF "BerkeleyDB::Error"
469
470 #define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \
471 Zero(to,1,typ))
472
473 #define DBT_clear(x) Zero(&x, 1, DBT) ;
474
475 #if 1
476 #define getInnerObject(x) (*av_fetch((AV*)SvRV(x), 0, FALSE))
477 #else
478 #define getInnerObject(x) ((SV*)SvRV(sv))
479 #endif
480
481 #define my_sv_setpvn(sv, d, s) do { \
482 s ? sv_setpvn(sv, d, s) : sv_setpv(sv, ""); \
483 SvUTF8_off(sv); \
484 } while(0)
485
486 #define GetValue_iv(h,k) (((sv = readHash(h, k)) && sv != &PL_sv_undef) \
487 ? SvIV(sv) : 0)
488 #define SetValue_iv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
489 i = SvIV(sv)
490 #define SetValue_io(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
491 i = GetFILEptr(sv)
492 #define SetValue_sv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
493 i = sv
494 #define SetValue_pv(i, k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
495 i = (t)SvPV(sv,PL_na)
496 #define SetValue_pvx(i, k, t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \
497 i = (t)SvPVX(sv)
498 #define SetValue_ov(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
499 IV tmp = SvIV(getInnerObject(sv)) ; \
500 i = INT2PTR(t, tmp) ; \
501 }
502
503 #define SetValue_ovx(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
504 HV * hv = (HV *)GetInternalObject(sv); \
505 SV ** svp = hv_fetch(hv, "db", 2, FALSE);\
506 IV tmp = SvIV(*svp); \
507 i = INT2PTR(t, tmp) ; \
508 }
509
510 #define SetValue_ovX(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\
511 IV tmp = SvIV(GetInternalObject(sv));\
512 i = INT2PTR(t, tmp) ; \
513 }
514
515 #define LastDBerror DB_RUNRECOVERY
516
517 #define setDUALerrno(var, err) \
518 sv_setnv(var, (double)err) ; \
519 sv_setpv(var, ((err) ? db_strerror(err) : "")) ;\
520 SvNOK_on(var);
521
522 #define OutputValue(arg, name) \
523 { if (RETVAL == 0) { \
524 my_sv_setpvn(arg, name.data, name.size) ; \
525 DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
526 } \
527 }
528
529 #define OutputValue_B(arg, name) \
530 { if (RETVAL == 0) { \
531 if (db->type == DB_BTREE && \
532 flagSet(DB_GET_RECNO)){ \
533 sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
534 } \
535 else { \
536 my_sv_setpvn(arg, name.data, name.size) ; \
537 } \
538 DBM_ckFilter(arg, filter_fetch_value, "filter_fetch_value"); \
539 } \
540 }
541
542 #define OutputKey(arg, name) \
543 { if (RETVAL == 0) \
544 { \
545 if (!db->recno_or_queue) { \
546 my_sv_setpvn(arg, name.data, name.size); \
547 } \
548 else \
549 sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE); \
550 if (! isHeapDb(db)) \
551 DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \
552 } \
553 }
554
555 #ifdef AT_LEAST_DB_4_3
556
557 #define InputKey_seq(arg, var) \
558 { \
559 SV* my_sv = arg ; \
560 /* DBM_ckFilter(my_sv, filter_store_key, "filter_store_key"); */ \
561 DBT_clear(var) ; \
562 SvGETMAGIC(arg) ; \
563 if (seq->db->recno_or_queue) { \
564 Value = GetRecnoKey(seq->db, SvIV(my_sv)) ; \
565 var.data = & Value; \
566 var.size = (int)sizeof(db_recno_t); \
567 } \
568 else { \
569 STRLEN len; \
570 var.data = SvPV(my_sv, len); \
571 var.size = (int)len; \
572 } \
573 }
574
575 #define OutputKey_seq(arg, name) \
576 { if (RETVAL == 0) \
577 { \
578 if (!seq->db->recno_or_queue) { \
579 my_sv_setpvn(arg, name.data, name.size); \
580 } \
581 else \
582 sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE); \
583 } \
584 }
585 #else
586 #define InputKey_seq(arg, var)
587 #define OutputKey_seq(arg, name)
588 #endif
589
590 #define OutputKey_B(arg, name) \
591 { if (RETVAL == 0) \
592 { \
593 if (db->recno_or_queue \
594 || (db->type == DB_BTREE && \
595 flagSet(DB_GET_RECNO))){ \
596 sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
597 } \
598 else { \
599 my_sv_setpvn(arg, name.data, name.size); \
600 } \
601 DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \
602 } \
603 }
604
605 #define OutputKey_Br(arg, name) \
606 { if (RETVAL == 0) \
607 { \
608 if (db->recno_or_queue || db->primary_recno_or_queue \
609 || (db->type == DB_BTREE && \
610 flagSet(DB_GET_RECNO))){ \
611 sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
612 } \
613 else { \
614 my_sv_setpvn(arg, name.data, name.size); \
615 } \
616 DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \
617 } \
618 }
619
620 #define OutputKey_Bpr(arg, name) \
621 { if (RETVAL == 0) \
622 { \
623 if (db->primary_recno_or_queue \
624 || (db->type == DB_BTREE && \
625 flagSet(DB_GET_RECNO))){ \
626 sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \
627 } \
628 else { \
629 my_sv_setpvn(arg, name.data, name.size); \
630 } \
631 DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \
632 } \
633 }
634
635 #define SetPartial(data,db) \
636 data.flags = db->partial ; \
637 data.dlen = db->dlen ; \
638 data.doff = db->doff ;
639
640 #define ckActive(active, type) \
641 { \
642 if (!active) \
643 softCrash("%s is already closed", type) ; \
644 }
645
646 #define ckActive_Environment(a) ckActive(a, "Environment")
647 #define ckActive_TxnMgr(a) ckActive(a, "Transaction Manager")
648 #define ckActive_Transaction(a) ckActive(a, "Transaction")
649 #define ckActive_Database(a) ckActive(a, "Database")
650 #define ckActive_Cursor(a) ckActive(a, "Cursor")
651 #ifdef AT_LEAST_DB_4_3
652 #define ckActive_Sequence(a) ckActive(a, "Sequence")
653 #else
654 #define ckActive_Sequence(a)
655 #endif
656
657 #define dieIfEnvOpened(e, m) if (e->opened) softCrash("Cannot call method BerkeleyDB::Env::%s after environment has been opened", m);
658
659 #define isSTDOUT_ERR(f) ((f) == stdout || (f) == stderr)
660
661
662 /* Internal Global Data */
663 #define MY_CXT_KEY "BerkeleyDB::_guts" XS_VERSION
664
665 typedef struct {
666 db_recno_t x_Value;
667 db_recno_t x_zero;
668 DBTKEY x_empty;
669 #ifndef AT_LEAST_DB_3_2
670 BerkeleyDB x_CurrentDB;
671 #endif
672 } my_cxt_t;
673
674 START_MY_CXT
675
676 #define Value (MY_CXT.x_Value)
677 #define zero (MY_CXT.x_zero)
678 #define empty (MY_CXT.x_empty)
679
680 #ifdef AT_LEAST_DB_3_2
681 # define CurrentDB ((BerkeleyDB)db->BackRef)
682 #else
683 # define CurrentDB (MY_CXT.x_CurrentDB)
684 #endif
685
686 #ifdef AT_LEAST_DB_3_2
687 # define getCurrentDB ((BerkeleyDB)db->BackRef)
688 # define saveCurrentDB(db)
689 #else
690 # define getCurrentDB (MY_CXT.x_CurrentDB)
691 # define saveCurrentDB(db) (MY_CXT.x_CurrentDB) = db
692 #endif
693
694 #if 0
695 static char ErrBuff[1000] ;
696 #endif
697
698 #ifdef AT_LEAST_DB_3_3
699 # if PERL_REVISION == 5 && PERL_VERSION <= 4
700
701 /* saferealloc in perl5.004 will croak if it is given a NULL pointer*/
702 void *
MyRealloc(void * ptr,size_t size)703 MyRealloc(void * ptr, size_t size)
704 {
705 if (ptr == NULL )
706 return safemalloc(size) ;
707 else
708 return saferealloc(ptr, size) ;
709 }
710
711 # else
712 # define MyRealloc saferealloc
713 # endif
714 #endif
715
716 static char *
my_strdup(const char * s)717 my_strdup(const char *s)
718 {
719 if (s == NULL)
720 return NULL ;
721
722 {
723 MEM_SIZE l = strlen(s) + 1;
724 char *s1 = (char *)safemalloc(l);
725
726 Copy(s, s1, (MEM_SIZE)l, char);
727 return s1;
728 }
729 }
730
731 #if DB_VERSION_MAJOR == 2
732 static char *
db_strerror(int err)733 db_strerror(int err)
734 {
735 if (err == 0)
736 return "" ;
737
738 if (err > 0)
739 return Strerror(err) ;
740
741 switch (err) {
742 case DB_INCOMPLETE:
743 return ("DB_INCOMPLETE: Sync was unable to complete");
744 case DB_KEYEMPTY:
745 return ("DB_KEYEMPTY: Non-existent key/data pair");
746 case DB_KEYEXIST:
747 return ("DB_KEYEXIST: Key/data pair already exists");
748 case DB_LOCK_DEADLOCK:
749 return (
750 "DB_LOCK_DEADLOCK: Locker killed to resolve a deadlock");
751 case DB_LOCK_NOTGRANTED:
752 return ("DB_LOCK_NOTGRANTED: Lock not granted");
753 case DB_LOCK_NOTHELD:
754 return ("DB_LOCK_NOTHELD: Lock not held by locker");
755 case DB_NOTFOUND:
756 return ("DB_NOTFOUND: No matching key/data pair found");
757 case DB_RUNRECOVERY:
758 return ("DB_RUNRECOVERY: Fatal error, run database recovery");
759 default:
760 return "Unknown Error" ;
761
762 }
763 }
764 #endif /* DB_VERSION_MAJOR == 2 */
765
766 #ifdef TRACE
767 #if DB_VERSION_MAJOR > 2
768 static char *
my_db_strerror(int err)769 my_db_strerror(int err)
770 {
771 static char buffer[1000] ;
772 SV * sv = perl_get_sv(ERR_BUFF, FALSE) ;
773 sprintf(buffer, "%d: %s", err, db_strerror(err)) ;
774 if (err && sv) {
775 strcat(buffer, ", ") ;
776 strcat(buffer, SvPVX(sv)) ;
777 }
778 return buffer;
779 }
780 #endif
781 #endif
782
783 static void
close_everything(void)784 close_everything(void)
785 {
786 dTHR;
787 Trace(("close_everything\n")) ;
788 /* Abort All Transactions */
789 {
790 BerkeleyDB__Txn__Raw tid ;
791 HE * he ;
792 I32 len ;
793 HV * hv = perl_get_hv("BerkeleyDB::Term::Txn", TRUE);
794 int all = 0 ;
795 int closed = 0 ;
796 (void)hv_iterinit(hv) ;
797 Trace(("BerkeleyDB::Term::close_all_txns dirty=%d\n", PL_dirty)) ;
798 while ( (he = hv_iternext(hv)) ) {
799 tid = * (BerkeleyDB__Txn__Raw *) hv_iterkey(he, &len) ;
800 Trace((" Aborting Transaction [%d] in [%d] Active [%d]\n", tid->txn, tid, tid->active));
801 if (tid->active) {
802 #ifdef AT_LEAST_DB_4
803 tid->txn->abort(tid->txn) ;
804 #else
805 txn_abort(tid->txn);
806 #endif
807 ++ closed ;
808 }
809 tid->active = FALSE ;
810 ++ all ;
811 }
812 Trace(("End of BerkeleyDB::Term::close_all_txns aborted %d of %d transactios\n",closed, all)) ;
813 }
814
815 /* Close All Cursors */
816 {
817 BerkeleyDB__Cursor db ;
818 HE * he ;
819 I32 len ;
820 HV * hv = perl_get_hv("BerkeleyDB::Term::Cursor", TRUE);
821 int all = 0 ;
822 int closed = 0 ;
823 (void) hv_iterinit(hv) ;
824 Trace(("BerkeleyDB::Term::close_all_cursors \n")) ;
825 while ( (he = hv_iternext(hv)) ) {
826 db = * (BerkeleyDB__Cursor*) hv_iterkey(he, &len) ;
827 Trace((" Closing Cursor [%d] in [%d] Active [%d]\n", db->cursor, db, db->active));
828 if (db->active) {
829 ((db->cursor)->c_close)(db->cursor) ;
830 ++ closed ;
831 }
832 db->active = FALSE ;
833 ++ all ;
834 }
835 Trace(("End of BerkeleyDB::Term::close_all_cursors closed %d of %d cursors\n",closed, all)) ;
836 }
837
838 /* Close All Databases */
839 {
840 BerkeleyDB db ;
841 HE * he ;
842 I32 len ;
843 HV * hv = perl_get_hv("BerkeleyDB::Term::Db", TRUE);
844 int all = 0 ;
845 int closed = 0 ;
846 (void)hv_iterinit(hv) ;
847 Trace(("BerkeleyDB::Term::close_all_dbs\n" )) ;
848 while ( (he = hv_iternext(hv)) ) {
849 db = * (BerkeleyDB*) hv_iterkey(he, &len) ;
850 Trace((" Closing Database [%d] in [%d] Active [%d]\n", db->dbp, db, db->active));
851 if (db->active) {
852 (db->dbp->close)(db->dbp, 0) ;
853 ++ closed ;
854 }
855 db->active = FALSE ;
856 ++ all ;
857 }
858 Trace(("End of BerkeleyDB::Term::close_all_dbs closed %d of %d dbs\n",closed, all)) ;
859 }
860
861 /* Close All Environments */
862 {
863 BerkeleyDB__Env env ;
864 HE * he ;
865 I32 len ;
866 HV * hv = perl_get_hv("BerkeleyDB::Term::Env", TRUE);
867 int all = 0 ;
868 int closed = 0 ;
869 (void)hv_iterinit(hv) ;
870 Trace(("BerkeleyDB::Term::close_all_envs\n")) ;
871 while ( (he = hv_iternext(hv)) ) {
872 env = * (BerkeleyDB__Env*) hv_iterkey(he, &len) ;
873 Trace((" Closing Environment [%d] in [%d] Active [%d]\n", env->Env, env, env->active));
874 if (env->active) {
875 #if DB_VERSION_MAJOR == 2
876 db_appexit(env->Env) ;
877 #else
878 (env->Env->close)(env->Env, 0) ;
879 #endif
880 ++ closed ;
881 }
882 env->active = FALSE ;
883 ++ all ;
884 }
885 Trace(("End of BerkeleyDB::Term::close_all_envs closed %d of %d dbs\n",closed, all)) ;
886 }
887
888 Trace(("end close_everything\n")) ;
889
890 }
891
892 static void
destroyDB(BerkeleyDB db)893 destroyDB(BerkeleyDB db)
894 {
895 dTHR;
896 if (! PL_dirty && db->active) {
897 if (db->parent_env && db->parent_env->open_dbs)
898 -- db->parent_env->open_dbs ;
899 -- db->open_cursors ;
900 ((db->dbp)->close)(db->dbp, 0) ;
901 }
902 if (db->hash)
903 SvREFCNT_dec(db->hash) ;
904 if (db->compare)
905 SvREFCNT_dec(db->compare) ;
906 if (db->dup_compare)
907 SvREFCNT_dec(db->dup_compare) ;
908 #ifdef AT_LEAST_DB_3_3
909 if (db->associated && !db->secondary_db)
910 SvREFCNT_dec(db->associated) ;
911 #endif
912 #ifdef AT_LEAST_DB_4_8
913 if (db->associated_foreign)
914 SvREFCNT_dec(db->associated_foreign) ;
915 #endif
916 if (db->prefix)
917 SvREFCNT_dec(db->prefix) ;
918 #ifdef DBM_FILTERING
919 if (db->filter_fetch_key)
920 SvREFCNT_dec(db->filter_fetch_key) ;
921 if (db->filter_store_key)
922 SvREFCNT_dec(db->filter_store_key) ;
923 if (db->filter_fetch_value)
924 SvREFCNT_dec(db->filter_fetch_value) ;
925 if (db->filter_store_value)
926 SvREFCNT_dec(db->filter_store_value) ;
927 #endif
928 hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
929 if (db->filename)
930 Safefree(db->filename) ;
931 Safefree(db) ;
932 }
933
934 static int
softCrash(const char * pat,...)935 softCrash(const char *pat, ...)
936 {
937 char buffer1 [500] ;
938 char buffer2 [500] ;
939 va_list args;
940 va_start(args, pat);
941
942 Trace(("softCrash: %s\n", pat)) ;
943
944 #define ABORT_PREFIX "BerkeleyDB Aborting: "
945
946 /* buffer = (char*) safemalloc(strlen(pat) + strlen(ABORT_PREFIX) + 1) ; */
947 strcpy(buffer1, ABORT_PREFIX) ;
948 strcat(buffer1, pat) ;
949
950 vsprintf(buffer2, buffer1, args) ;
951
952 croak(buffer2);
953
954 /* NOTREACHED */
955 va_end(args);
956 return 1 ;
957 }
958
959
960 static I32
GetArrayLength(BerkeleyDB db)961 GetArrayLength(BerkeleyDB db)
962 {
963 DBT key ;
964 DBT value ;
965 int RETVAL = 0 ;
966 DBC * cursor ;
967
968 DBT_clear(key) ;
969 DBT_clear(value) ;
970 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
971 if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor) == 0 )
972 #else
973 if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor, 0) == 0 )
974 #endif
975 {
976 RETVAL = cursor->c_get(cursor, &key, &value, DB_LAST) ;
977 if (RETVAL == 0)
978 RETVAL = *(I32 *)key.data ;
979 else /* No key means empty file */
980 RETVAL = 0 ;
981 cursor->c_close(cursor) ;
982 }
983
984 Trace(("GetArrayLength got %d\n", RETVAL)) ;
985 return ((I32)RETVAL) ;
986 }
987
988 #if 0
989
990 #define GetRecnoKey(db, value) _GetRecnoKey(db, value)
991
992 static db_recno_t
993 _GetRecnoKey(BerkeleyDB db, I32 value)
994 {
995 Trace(("GetRecnoKey start value = %d\n", value)) ;
996 if (db->recno_or_queue && value < 0) {
997 /* Get the length of the array */
998 I32 length = GetArrayLength(db) ;
999
1000 /* check for attempt to write before start of array */
1001 if (length + value + RECNO_BASE <= 0)
1002 softCrash("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
1003
1004 value = length + value + RECNO_BASE ;
1005 }
1006 else
1007 ++ value ;
1008
1009 Trace(("GetRecnoKey end value = %d\n", value)) ;
1010
1011 return value ;
1012 }
1013
1014 #else /* ! 0 */
1015
1016 #if 0
1017 #ifdef ALLOW_RECNO_OFFSET
1018 #define GetRecnoKey(db, value) _GetRecnoKey(db, value)
1019
1020 static db_recno_t
1021 _GetRecnoKey(BerkeleyDB db, I32 value)
1022 {
1023 if (value + RECNO_BASE < 1)
1024 softCrash("key value %d < base (%d)", (value), RECNO_BASE?0:1) ;
1025 return value + RECNO_BASE ;
1026 }
1027
1028 #else
1029 #endif /* ALLOW_RECNO_OFFSET */
1030 #endif /* 0 */
1031
1032 #define GetRecnoKey(db, value) ((value) + RECNO_BASE )
1033
1034 #endif /* 0 */
1035
1036 #if 0
1037 static SV *
1038 GetInternalObject(SV * sv)
1039 {
1040 SV * info = (SV*) NULL ;
1041 SV * s ;
1042 MAGIC * mg ;
1043
1044 Trace(("in GetInternalObject %d\n", sv)) ;
1045 if (sv == NULL || !SvROK(sv))
1046 return NULL ;
1047
1048 s = SvRV(sv) ;
1049 if (SvMAGICAL(s))
1050 {
1051 if (SvTYPE(s) == SVt_PVHV || SvTYPE(s) == SVt_PVAV)
1052 mg = mg_find(s, 'P') ;
1053 else
1054 mg = mg_find(s, 'q') ;
1055
1056 /* all this testing is probably overkill, but till I know more
1057 about global destruction it stays.
1058 */
1059 /* if (mg && mg->mg_obj && SvRV(mg->mg_obj) && SvPVX(SvRV(mg->mg_obj))) */
1060 if (mg && mg->mg_obj && SvRV(mg->mg_obj) )
1061 info = SvRV(mg->mg_obj) ;
1062 else
1063 info = s ;
1064 }
1065
1066 Trace(("end of GetInternalObject %d\n", info)) ;
1067 return info ;
1068 }
1069 #endif
1070
1071 static int
btree_compare(DB_callback const DBT * key1,const DBT * key2)1072 btree_compare(DB_callback const DBT * key1, const DBT * key2 )
1073 {
1074 #ifdef dTHX
1075 dTHX;
1076 #endif
1077 dSP ;
1078 dMY_CXT ;
1079 char * data1, * data2 ;
1080 int retval ;
1081 int count ;
1082 /* BerkeleyDB keepDB = getCurrentDB ; */
1083
1084 Trace(("In btree_compare \n")) ;
1085 data1 = (char*) key1->data ;
1086 data2 = (char*) key2->data ;
1087
1088 #ifndef newSVpvn
1089 /* As newSVpv will assume that the data pointer is a null terminated C
1090 string if the size parameter is 0, make sure that data points to an
1091 empty string if the length is 0
1092 */
1093 if (key1->size == 0)
1094 data1 = "" ;
1095 if (key2->size == 0)
1096 data2 = "" ;
1097 #endif
1098
1099 ENTER ;
1100 SAVETMPS;
1101
1102 /* SAVESPTR(CurrentDB); */
1103
1104 PUSHMARK(SP) ;
1105 EXTEND(SP,2) ;
1106 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1107 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1108 PUTBACK ;
1109
1110 count = perl_call_sv(getCurrentDB->compare, G_SCALAR);
1111
1112 SPAGAIN ;
1113
1114 if (count != 1)
1115 softCrash ("in btree_compare - expected 1 return value from compare sub, got %d", count) ;
1116
1117 retval = POPi ;
1118
1119 PUTBACK ;
1120 FREETMPS ;
1121 LEAVE ;
1122 /* CurrentDB = keepDB ; */
1123 return (retval) ;
1124
1125 }
1126
1127 static int
dup_compare(DB_callback const DBT * key1,const DBT * key2)1128 dup_compare(DB_callback const DBT * key1, const DBT * key2 )
1129 {
1130 #ifdef dTHX
1131 dTHX;
1132 #endif
1133 dSP ;
1134 dMY_CXT ;
1135 char * data1, * data2 ;
1136 int retval ;
1137 int count ;
1138 /* BerkeleyDB keepDB = CurrentDB ; */
1139
1140 Trace(("In dup_compare \n")) ;
1141 if (!getCurrentDB)
1142 softCrash("Internal Error - No CurrentDB in dup_compare") ;
1143 if (getCurrentDB->dup_compare == NULL)
1144
1145
1146 softCrash("in dup_compare: no callback specified for database '%s'", getCurrentDB->filename) ;
1147
1148 data1 = (char*) key1->data ;
1149 data2 = (char*) key2->data ;
1150
1151 #ifndef newSVpvn
1152 /* As newSVpv will assume that the data pointer is a null terminated C
1153 string if the size parameter is 0, make sure that data points to an
1154 empty string if the length is 0
1155 */
1156 if (key1->size == 0)
1157 data1 = "" ;
1158 if (key2->size == 0)
1159 data2 = "" ;
1160 #endif
1161
1162 ENTER ;
1163 SAVETMPS;
1164
1165 PUSHMARK(SP) ;
1166 EXTEND(SP,2) ;
1167 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1168 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1169 PUTBACK ;
1170
1171 count = perl_call_sv(getCurrentDB->dup_compare, G_SCALAR);
1172
1173 SPAGAIN ;
1174
1175 if (count != 1)
1176 softCrash ("dup_compare: expected 1 return value from compare sub, got %d", count) ;
1177
1178 retval = POPi ;
1179
1180 PUTBACK ;
1181 FREETMPS ;
1182 LEAVE ;
1183 /* CurrentDB = keepDB ; */
1184 return (retval) ;
1185
1186 }
1187
1188 static size_t
btree_prefix(DB_callback const DBT * key1,const DBT * key2)1189 btree_prefix(DB_callback const DBT * key1, const DBT * key2 )
1190 {
1191 #ifdef dTHX
1192 dTHX;
1193 #endif
1194 dSP ;
1195 dMY_CXT ;
1196 char * data1, * data2 ;
1197 int retval ;
1198 int count ;
1199 /* BerkeleyDB keepDB = CurrentDB ; */
1200
1201 Trace(("In btree_prefix \n")) ;
1202 data1 = (char*) key1->data ;
1203 data2 = (char*) key2->data ;
1204
1205 #ifndef newSVpvn
1206 /* As newSVpv will assume that the data pointer is a null terminated C
1207 string if the size parameter is 0, make sure that data points to an
1208 empty string if the length is 0
1209 */
1210 if (key1->size == 0)
1211 data1 = "" ;
1212 if (key2->size == 0)
1213 data2 = "" ;
1214 #endif
1215
1216 ENTER ;
1217 SAVETMPS;
1218
1219 PUSHMARK(SP) ;
1220 EXTEND(SP,2) ;
1221 PUSHs(sv_2mortal(newSVpvn(data1,key1->size)));
1222 PUSHs(sv_2mortal(newSVpvn(data2,key2->size)));
1223 PUTBACK ;
1224
1225 count = perl_call_sv(getCurrentDB->prefix, G_SCALAR);
1226
1227 SPAGAIN ;
1228
1229 if (count != 1)
1230 softCrash ("btree_prefix: expected 1 return value from prefix sub, got %d", count) ;
1231
1232 retval = POPi ;
1233
1234 PUTBACK ;
1235 FREETMPS ;
1236 LEAVE ;
1237 /* CurrentDB = keepDB ; */
1238
1239 return (retval) ;
1240 }
1241
1242 static u_int32_t
hash_cb(DB_callback const void * data,u_int32_t size)1243 hash_cb(DB_callback const void * data, u_int32_t size)
1244 {
1245 #ifdef dTHX
1246 dTHX;
1247 #endif
1248 dSP ;
1249 dMY_CXT ;
1250 int retval ;
1251 int count ;
1252 /* BerkeleyDB keepDB = CurrentDB ; */
1253
1254 Trace(("In hash_cb \n")) ;
1255 #ifndef newSVpvn
1256 if (size == 0)
1257 data = "" ;
1258 #endif
1259
1260 ENTER ;
1261 SAVETMPS;
1262
1263 PUSHMARK(SP) ;
1264
1265 XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
1266 PUTBACK ;
1267
1268 count = perl_call_sv(getCurrentDB->hash, G_SCALAR);
1269
1270 SPAGAIN ;
1271
1272 if (count != 1)
1273 softCrash ("hash_cb: expected 1 return value from hash sub, got %d", count) ;
1274
1275 retval = POPi ;
1276
1277 PUTBACK ;
1278 FREETMPS ;
1279 LEAVE ;
1280 /* CurrentDB = keepDB ; */
1281
1282 return (retval) ;
1283 }
1284
1285 #ifdef AT_LEAST_DB_3_3
1286
1287 static int
associate_cb(DB_callback const DBT * pkey,const DBT * pdata,DBT * skey)1288 associate_cb(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
1289 {
1290 #ifdef dTHX
1291 dTHX;
1292 #endif
1293 dSP ;
1294 dMY_CXT ;
1295 char * pk_dat, * pd_dat ;
1296 /* char *sk_dat ; */
1297 int retval ;
1298 int count ;
1299 int i ;
1300 SV * skey_SV ;
1301 STRLEN skey_len;
1302 char * skey_ptr ;
1303 AV * skey_AV;
1304 DBT * tkey;
1305
1306 Trace(("In associate_cb \n")) ;
1307 if (getCurrentDB->associated == NULL){
1308 Trace(("No Callback registered\n")) ;
1309 return EINVAL ;
1310 }
1311
1312 skey_SV = newSVpv("",0);
1313
1314
1315 pk_dat = (char*) pkey->data ;
1316 pd_dat = (char*) pdata->data ;
1317
1318 #ifndef newSVpvn
1319 /* As newSVpv will assume that the data pointer is a null terminated C
1320 string if the size parameter is 0, make sure that data points to an
1321 empty string if the length is 0
1322 */
1323 if (pkey->size == 0)
1324 pk_dat = "" ;
1325 if (pdata->size == 0)
1326 pd_dat = "" ;
1327 #endif
1328
1329 ENTER ;
1330 SAVETMPS;
1331
1332 PUSHMARK(SP) ;
1333 EXTEND(SP,3) ;
1334 PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
1335 PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
1336 PUSHs(sv_2mortal(skey_SV));
1337 PUTBACK ;
1338
1339 Trace(("calling associated cb\n"));
1340 count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
1341 Trace(("called associated cb\n"));
1342
1343 SPAGAIN ;
1344
1345 if (count != 1)
1346 softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;
1347
1348 retval = POPi ;
1349
1350 PUTBACK ;
1351
1352 if (retval != DB_DONOTINDEX)
1353 {
1354 /* retrieve the secondary key */
1355 DBT_clear(*skey);
1356
1357 skey->flags = DB_DBT_APPMALLOC;
1358
1359 #ifdef AT_LEAST_DB_4_6
1360 if ( SvROK(skey_SV) ) {
1361 SV *rv = SvRV(skey_SV);
1362
1363 if ( SvTYPE(rv) == SVt_PVAV ) {
1364 AV *av = (AV *)rv;
1365 SV **svs = AvARRAY(av);
1366 I32 len = av_len(av) + 1;
1367 I32 i;
1368 DBT *dbts;
1369
1370 if ( len == 0 ) {
1371 retval = DB_DONOTINDEX;
1372 } else if ( len == 1 ) {
1373 skey_ptr = SvPV(svs[0], skey_len);
1374 skey->size = skey_len;
1375 skey->data = (char*)safemalloc(skey_len);
1376 memcpy(skey->data, skey_ptr, skey_len);
1377 Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1378 } else {
1379 skey->flags |= DB_DBT_MULTIPLE ;
1380
1381 /* FIXME this will leak if safemalloc fails later... do we care? */
1382 dbts = (DBT *) safemalloc(sizeof(DBT) * len);
1383 skey->size = len;
1384 skey->data = (char *)dbts;
1385
1386 for ( i = 0; i < skey->size; i ++ ) {
1387 skey_ptr = SvPV(svs[i], skey_len);
1388
1389 dbts[i].flags = DB_DBT_APPMALLOC;
1390 dbts[i].size = skey_len;
1391 dbts[i].data = (char *)safemalloc(skey_len);
1392 memcpy(dbts[i].data, skey_ptr, skey_len);
1393
1394 Trace(("key is %d -- %.*s\n", dbts[i].size, dbts[i].size, dbts[i].data));
1395 }
1396 Trace(("mkey has %d subkeys\n", skey->size));
1397 }
1398 } else {
1399 croak("Not an array reference");
1400 }
1401 } else
1402 #endif
1403 {
1404 skey_ptr = SvPV(skey_SV, skey_len);
1405 /* skey->size = SvCUR(skey_SV); */
1406 /* skey->data = (char*)safemalloc(skey->size); */
1407 skey->size = skey_len;
1408 skey->data = (char*)safemalloc(skey_len);
1409 memcpy(skey->data, skey_ptr, skey_len);
1410 }
1411 }
1412 Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));
1413
1414 FREETMPS ;
1415 LEAVE ;
1416
1417 return (retval) ;
1418 }
1419
1420 static int
associate_cb_recno(DB_callback const DBT * pkey,const DBT * pdata,DBT * skey)1421 associate_cb_recno(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey)
1422 {
1423 #ifdef dTHX
1424 dTHX;
1425 #endif
1426 dSP ;
1427 dMY_CXT ;
1428 char * pk_dat, * pd_dat ;
1429 /* char *sk_dat ; */
1430 int retval ;
1431 int count ;
1432 SV * skey_SV ;
1433 STRLEN skey_len;
1434 char * skey_ptr ;
1435 /* db_recno_t Value; */
1436
1437 Trace(("In associate_cb_recno \n")) ;
1438 if (getCurrentDB->associated == NULL){
1439 Trace(("No Callback registered\n")) ;
1440 return EINVAL ;
1441 }
1442
1443 skey_SV = newSVpv("",0);
1444
1445
1446 pk_dat = (char*) pkey->data ;
1447 pd_dat = (char*) pdata->data ;
1448
1449 #ifndef newSVpvn
1450 /* As newSVpv will assume that the data pointer is a null terminated C
1451 string if the size parameter is 0, make sure that data points to an
1452 empty string if the length is 0
1453 */
1454 if (pkey->size == 0)
1455 pk_dat = "" ;
1456 if (pdata->size == 0)
1457 pd_dat = "" ;
1458 #endif
1459
1460 ENTER ;
1461 SAVETMPS;
1462
1463 PUSHMARK(SP) ;
1464 EXTEND(SP,2) ;
1465 PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size)));
1466 PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size)));
1467 PUSHs(sv_2mortal(skey_SV));
1468 PUTBACK ;
1469
1470 Trace(("calling associated cb\n"));
1471 count = perl_call_sv(getCurrentDB->associated, G_SCALAR);
1472 Trace(("called associated cb\n"));
1473
1474 SPAGAIN ;
1475
1476 if (count != 1)
1477 softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ;
1478
1479 retval = POPi ;
1480
1481 PUTBACK ;
1482
1483 /* retrieve the secondary key */
1484 DBT_clear(*skey);
1485
1486 if (retval != DB_DONOTINDEX)
1487 {
1488 Value = GetRecnoKey(getCurrentDB, SvIV(skey_SV)) ;
1489 skey->flags = DB_DBT_APPMALLOC;
1490 skey->size = (int)sizeof(db_recno_t);
1491 skey->data = (char*)safemalloc(skey->size);
1492 memcpy(skey->data, &Value, skey->size);
1493 }
1494
1495 FREETMPS ;
1496 LEAVE ;
1497
1498 return (retval) ;
1499 }
1500
1501 #endif /* AT_LEAST_DB_3_3 */
1502
1503 #ifdef AT_LEAST_DB_4_8
1504
1505 typedef int (*bt_compress_fcn_type)(DB *db, const DBT *prevKey,
1506 const DBT *prevData, const DBT *key, const DBT *data, DBT *dest);
1507
1508 typedef int (*bt_decompress_fcn_type)(DB *db, const DBT *prevKey,
1509 const DBT *prevData, DBT *compressed, DBT *destKey, DBT *destData);
1510
1511 #endif /* AT_LEAST_DB_4_8 */
1512
1513 typedef int (*foreign_cb_type)(DB *, const DBT *, DBT *, const DBT *, int *) ;
1514
1515 #ifdef AT_LEAST_DB_4_8
1516
1517 static int
associate_foreign_cb(DB * db,const DBT * key,DBT * data,const DBT * foreignkey,int * changed)1518 associate_foreign_cb(DB* db, const DBT * key, DBT * data, const DBT * foreignkey, int* changed)
1519 {
1520 #ifdef dTHX
1521 dTHX;
1522 #endif
1523 dSP ;
1524 dMY_CXT ;
1525 char * k_dat, * d_dat, * f_dat;
1526 int retval ;
1527 int count ;
1528 int i ;
1529 SV * changed_SV ;
1530 STRLEN skey_len;
1531 char * skey_ptr ;
1532 AV * skey_AV;
1533 DBT * tkey;
1534 SV* data_sv ;
1535
1536 Trace(("In associate_foreign_cb \n")) ;
1537 if (getCurrentDB->associated_foreign == NULL){
1538 Trace(("No Callback registered\n")) ;
1539 return EINVAL ;
1540 }
1541
1542 changed_SV = newSViv(*changed);
1543
1544
1545 k_dat = (char*) key->data ;
1546 d_dat = (char*) data->data ;
1547 f_dat = (char*) foreignkey->data ;
1548
1549 #ifndef newSVpvn
1550 /* As newSVpv will assume that the data pointer is a null terminated C
1551 string if the size parameter is 0, make sure that data points to an
1552 empty string if the length is 0
1553 */
1554 if (key->size == 0)
1555 k_dat = "" ;
1556 if (data->size == 0)
1557 d_dat = "" ;
1558 if (foreignkey->size == 0)
1559 f_dat = "" ;
1560 #endif
1561
1562 ENTER ;
1563 SAVETMPS;
1564
1565 PUSHMARK(SP) ;
1566 EXTEND(SP,4) ;
1567
1568 PUSHs(sv_2mortal(newSVpvn(k_dat,key->size)));
1569 data_sv = newSVpv(d_dat, data->size);
1570 PUSHs(sv_2mortal(data_sv));
1571 PUSHs(sv_2mortal(newSVpvn(f_dat,foreignkey->size)));
1572 PUSHs(sv_2mortal(changed_SV));
1573 PUTBACK ;
1574
1575 Trace(("calling associated cb\n"));
1576 count = perl_call_sv(getCurrentDB->associated_foreign, G_SCALAR);
1577 Trace(("called associated cb\n"));
1578
1579 SPAGAIN ;
1580
1581 if (count != 1)
1582 softCrash ("associate_foreign: expected 1 return value from prefix sub, got %d", count) ;
1583
1584 retval = POPi ;
1585
1586 PUTBACK ;
1587
1588 *changed = SvIV(changed_SV);
1589
1590 if (*changed)
1591 {
1592 DBT_clear(*data);
1593 data->flags = DB_DBT_APPMALLOC;
1594 skey_ptr = SvPV(data_sv, skey_len);
1595 data->size = skey_len;
1596 data->data = (char*)safemalloc(skey_len);
1597 memcpy(data->data, skey_ptr, skey_len);
1598 }
1599 /*Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));*/
1600
1601 FREETMPS ;
1602 LEAVE ;
1603
1604 return (retval) ;
1605 }
1606
1607 static int
associate_foreign_cb_recno(DB * db,const DBT * key,DBT * data,const DBT * foreignkey,int * changed)1608 associate_foreign_cb_recno(DB* db, const DBT * key, DBT * data, const DBT * foreignkey, int* changed)
1609 {
1610 #ifdef dTHX
1611 dTHX;
1612 #endif
1613 dSP ;
1614 dMY_CXT ;
1615 char * k_dat, * d_dat, * f_dat;
1616 int retval ;
1617 int count ;
1618 int i ;
1619 SV * changed_SV ;
1620 STRLEN skey_len;
1621 char * skey_ptr ;
1622 AV * skey_AV;
1623 DBT * tkey;
1624 SV* data_sv ;
1625
1626 Trace(("In associate_foreign_cb \n")) ;
1627 if (getCurrentDB->associated_foreign == NULL){
1628 Trace(("No Callback registered\n")) ;
1629 return EINVAL ;
1630 }
1631
1632 changed_SV = newSViv(*changed);
1633
1634
1635 k_dat = (char*) key->data ;
1636 d_dat = (char*) data->data ;
1637 f_dat = (char*) foreignkey->data ;
1638
1639 #ifndef newSVpvn
1640 /* As newSVpv will assume that the data pointer is a null terminated C
1641 string if the size parameter is 0, make sure that data points to an
1642 empty string if the length is 0
1643 */
1644 if (key->size == 0)
1645 k_dat = "" ;
1646 if (data->size == 0)
1647 d_dat = "" ;
1648 if (foreignkey->size == 0)
1649 f_dat = "" ;
1650 #endif
1651
1652 ENTER ;
1653 SAVETMPS;
1654
1655 PUSHMARK(SP) ;
1656 EXTEND(SP,4) ;
1657
1658 PUSHs(sv_2mortal(newSVpvn(k_dat,key->size)));
1659 data_sv = newSVpv(d_dat, data->size);
1660 PUSHs(sv_2mortal(data_sv));
1661 PUSHs(sv_2mortal(newSVpvn(f_dat,foreignkey->size)));
1662 PUSHs(sv_2mortal(changed_SV));
1663 PUTBACK ;
1664
1665 Trace(("calling associated cb\n"));
1666 count = perl_call_sv(getCurrentDB->associated_foreign, G_SCALAR);
1667 Trace(("called associated cb\n"));
1668
1669 SPAGAIN ;
1670
1671 if (count != 1)
1672 softCrash ("associate_foreign: expected 1 return value from prefix sub, got %d", count) ;
1673
1674 retval = POPi ;
1675
1676 PUTBACK ;
1677
1678 *changed = SvIV(changed_SV);
1679
1680 if (*changed)
1681 {
1682 DBT_clear(*data);
1683 Value = GetRecnoKey(getCurrentDB, SvIV(data_sv)) ;
1684 data->flags = DB_DBT_APPMALLOC;
1685 data->size = (int)sizeof(db_recno_t);
1686 data->data = (char*)safemalloc(data->size);
1687 memcpy(data->data, &Value, data->size);
1688 }
1689 /*Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data));*/
1690
1691 FREETMPS ;
1692 LEAVE ;
1693
1694 return (retval) ;
1695 }
1696
1697 #endif /* AT_LEAST_DB_3_3 */
1698
1699 static void
1700 #ifdef AT_LEAST_DB_4_3
db_errcall_cb(const DB_ENV * dbenv,const char * db_errpfx,const char * buffer)1701 db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
1702 #else
1703 db_errcall_cb(const char * db_errpfx, char * buffer)
1704 #endif
1705 {
1706 SV * sv;
1707
1708 Trace(("In errcall_cb \n")) ;
1709 #if 0
1710
1711 if (db_errpfx == NULL)
1712 db_errpfx = "" ;
1713 if (buffer == NULL )
1714 buffer = "" ;
1715 ErrBuff[0] = '\0';
1716 if (strlen(db_errpfx) + strlen(buffer) + 3 <= 1000) {
1717 if (*db_errpfx != '\0') {
1718 strcat(ErrBuff, db_errpfx) ;
1719 strcat(ErrBuff, ": ") ;
1720 }
1721 strcat(ErrBuff, buffer) ;
1722 }
1723
1724 #endif
1725
1726 sv = perl_get_sv(ERR_BUFF, FALSE) ;
1727 if (sv) {
1728 if (db_errpfx)
1729 sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ;
1730 else
1731 sv_setpv(sv, buffer) ;
1732 }
1733 }
1734
1735 #if defined(AT_LEAST_DB_4_4) && ! defined(_WIN32)
1736
1737 int
db_isalive_cb(DB_ENV * dbenv,pid_t pid,db_threadid_t tid,u_int32_t flags)1738 db_isalive_cb(DB_ENV *dbenv, pid_t pid, db_threadid_t tid, u_int32_t flags)
1739 {
1740 bool processAlive = ( kill(pid, 0) == 0 ) || ( errno != ESRCH );
1741 return processAlive;
1742 }
1743
1744 #endif
1745
1746
1747 static SV *
readHash(HV * hash,char * key)1748 readHash(HV * hash, char * key)
1749 {
1750 SV ** svp;
1751 svp = hv_fetch(hash, key, strlen(key), FALSE);
1752
1753 if (svp) {
1754 if (SvGMAGICAL(*svp))
1755 mg_get(*svp);
1756 if (SvOK(*svp))
1757 return *svp;
1758 }
1759
1760 return NULL ;
1761 }
1762
1763 static void
hash_delete(char * hash,char * key)1764 hash_delete(char * hash, char * key)
1765 {
1766 HV * hv = perl_get_hv(hash, TRUE);
1767 (void) hv_delete(hv, (char*)&key, sizeof(key), G_DISCARD);
1768 }
1769
1770 static void
hash_store_iv(char * hash,char * key,IV value)1771 hash_store_iv(char * hash, char * key, IV value)
1772 {
1773 HV * hv = perl_get_hv(hash, TRUE);
1774 (void)hv_store(hv, (char*)&key, sizeof(key), newSViv(value), 0);
1775 /* printf("hv_store returned %d\n", ret) ; */
1776 }
1777
1778 static void
hv_store_iv(HV * hash,char * key,IV value)1779 hv_store_iv(HV * hash, char * key, IV value)
1780 {
1781 hv_store(hash, key, strlen(key), newSViv(value), 0);
1782 }
1783
1784 #if 0
1785 static void
1786 hv_store_uv(HV * hash, char * key, UV value)
1787 {
1788 hv_store(hash, key, strlen(key), newSVuv(value), 0);
1789 }
1790 #endif
1791
1792 static void
GetKey(BerkeleyDB_type * db,SV * sv,DBTKEY * key)1793 GetKey(BerkeleyDB_type * db, SV * sv, DBTKEY * key)
1794 {
1795 dMY_CXT ;
1796 if (db->recno_or_queue) {
1797 Value = GetRecnoKey(db, SvIV(sv)) ;
1798 key->data = & Value;
1799 key->size = (int)sizeof(db_recno_t);
1800 }
1801 else {
1802 key->data = SvPV(sv, PL_na);
1803 key->size = (int)PL_na;
1804 }
1805 }
1806
1807 static BerkeleyDB
my_db_open(BerkeleyDB db,SV * ref,SV * ref_dbenv,BerkeleyDB__Env dbenv,BerkeleyDB__Txn txn,const char * file,const char * subname,DBTYPE type,int flags,int mode,DB_INFO * info,char * password,int enc_flags,HV * hash)1808 my_db_open(
1809 BerkeleyDB db ,
1810 SV * ref,
1811 SV * ref_dbenv ,
1812 BerkeleyDB__Env dbenv ,
1813 BerkeleyDB__Txn txn,
1814 const char * file,
1815 const char * subname,
1816 DBTYPE type,
1817 int flags,
1818 int mode,
1819 DB_INFO * info,
1820 char * password,
1821 int enc_flags,
1822 HV* hash
1823 )
1824 {
1825 DB_ENV * env = NULL ;
1826 BerkeleyDB RETVAL = NULL ;
1827 DB * dbp ;
1828 int Status ;
1829 DB_TXN* txnid = NULL ;
1830 dMY_CXT;
1831
1832 Trace(("_db_open(dbenv[%p] ref_dbenv [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
1833 dbenv, ref_dbenv, file, subname, type, flags, mode)) ;
1834
1835
1836 if (dbenv)
1837 env = dbenv->Env ;
1838
1839 if (txn)
1840 txnid = txn->txn;
1841
1842 Trace(("_db_open(dbenv[%p] ref_dbenv [%p] txn [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n",
1843 dbenv, ref_dbenv, txn, file, subname, type, flags, mode)) ;
1844
1845 #if DB_VERSION_MAJOR == 2
1846 if (subname)
1847 softCrash("Subname needs Berkeley DB 3 or better") ;
1848 #endif
1849
1850 #ifndef AT_LEAST_DB_4_1
1851 if (password)
1852 softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
1853 #endif /* ! AT_LEAST_DB_4_1 */
1854
1855 #ifndef AT_LEAST_DB_3_2
1856 CurrentDB = db ;
1857 #endif
1858
1859 #if DB_VERSION_MAJOR > 2
1860 Trace(("creating\n"));
1861 Status = db_create(&dbp, env, 0) ;
1862 Trace(("db_create returned %s\n", my_db_strerror(Status))) ;
1863 if (Status)
1864 return RETVAL ;
1865
1866 #ifdef AT_LEAST_DB_3_2
1867 dbp->BackRef = db;
1868 #endif
1869
1870 #ifdef AT_LEAST_DB_3_3
1871 if (! env) {
1872 dbp->set_alloc(dbp, safemalloc, MyRealloc, safefree) ;
1873 dbp->set_errcall(dbp, db_errcall_cb) ;
1874 }
1875 #endif
1876
1877 {
1878 /* Btree Compression */
1879 SV* sv;
1880 SV* wanted = NULL;
1881
1882 SetValue_sv(wanted, "set_bt_compress") ;
1883
1884 if (wanted)
1885 {
1886 #ifndef AT_LEAST_DB_4_8
1887 softCrash("set_bt_compress needs Berkeley DB 4.8 or better") ;
1888 #else
1889 bt_compress_fcn_type c = NULL;
1890 bt_decompress_fcn_type u = NULL;
1891 /*
1892 SV* compress = NULL;
1893 SV* uncompress = NULL;
1894
1895 SetValue_sv(compress, "_btcompress1") ;
1896 SetValue_sv(uncompress, "_btcompress2") ;
1897 if (compress)
1898 {
1899 c = ;
1900 db->bt_compress = newSVsv(compress) ;
1901 }
1902 */
1903
1904 Status = dbp->set_bt_compress(dbp, c, u);
1905
1906 if (Status)
1907 return RETVAL ;
1908 #endif /* AT_LEAST_DB_4_8 */
1909 }
1910 }
1911
1912 #ifdef AT_LEAST_DB_4_1
1913 /* set encryption */
1914 if (password)
1915 {
1916 Status = dbp->set_encrypt(dbp, password, enc_flags);
1917 Trace(("DB->set_encrypt passwd = %s, flags %d returned %s\n",
1918 password, enc_flags,
1919 my_db_strerror(Status))) ;
1920 if (Status)
1921 return RETVAL ;
1922 }
1923 #endif
1924
1925 if (info->re_source) {
1926 Status = dbp->set_re_source(dbp, info->re_source) ;
1927 Trace(("set_re_source [%s] returned %s\n",
1928 info->re_source, my_db_strerror(Status)));
1929 if (Status)
1930 return RETVAL ;
1931 }
1932
1933 if (info->db_cachesize) {
1934 Status = dbp->set_cachesize(dbp, 0, info->db_cachesize, 0) ;
1935 Trace(("set_cachesize [%d] returned %s\n",
1936 info->db_cachesize, my_db_strerror(Status)));
1937 if (Status)
1938 return RETVAL ;
1939 }
1940
1941 if (info->db_lorder) {
1942 Status = dbp->set_lorder(dbp, info->db_lorder) ;
1943 Trace(("set_lorder [%d] returned %s\n",
1944 info->db_lorder, my_db_strerror(Status)));
1945 if (Status)
1946 return RETVAL ;
1947 }
1948
1949 if (info->db_pagesize) {
1950 Status = dbp->set_pagesize(dbp, info->db_pagesize) ;
1951 Trace(("set_pagesize [%d] returned %s\n",
1952 info->db_pagesize, my_db_strerror(Status)));
1953 if (Status)
1954 return RETVAL ;
1955 }
1956
1957 if (info->h_ffactor) {
1958 Status = dbp->set_h_ffactor(dbp, info->h_ffactor) ;
1959 Trace(("set_h_ffactor [%d] returned %s\n",
1960 info->h_ffactor, my_db_strerror(Status)));
1961 if (Status)
1962 return RETVAL ;
1963 }
1964
1965 if (info->h_nelem) {
1966 Status = dbp->set_h_nelem(dbp, info->h_nelem) ;
1967 Trace(("set_h_nelem [%d] returned %s\n",
1968 info->h_nelem, my_db_strerror(Status)));
1969 if (Status)
1970 return RETVAL ;
1971 }
1972
1973 if (info->bt_minkey) {
1974 Status = dbp->set_bt_minkey(dbp, info->bt_minkey) ;
1975 Trace(("set_bt_minkey [%d] returned %s\n",
1976 info->bt_minkey, my_db_strerror(Status)));
1977 if (Status)
1978 return RETVAL ;
1979 }
1980
1981 if (info->bt_compare) {
1982 Status = dbp->set_bt_compare(dbp, info->bt_compare) ;
1983 Trace(("set_bt_compare [%p] returned %s\n",
1984 info->bt_compare, my_db_strerror(Status)));
1985 if (Status)
1986 return RETVAL ;
1987 }
1988
1989 if (info->h_hash) {
1990 Status = dbp->set_h_hash(dbp, info->h_hash) ;
1991 Trace(("set_h_hash [%d] returned %s\n",
1992 info->h_hash, my_db_strerror(Status)));
1993 if (Status)
1994 return RETVAL ;
1995 }
1996
1997
1998 if (info->dup_compare) {
1999 Status = dbp->set_dup_compare(dbp, info->dup_compare) ;
2000 Trace(("set_dup_compare [%d] returned %s\n",
2001 info->dup_compare, my_db_strerror(Status)));
2002 if (Status)
2003 return RETVAL ;
2004 }
2005
2006 if (info->bt_prefix) {
2007 Status = dbp->set_bt_prefix(dbp, info->bt_prefix) ;
2008 Trace(("set_bt_prefix [%d] returned %s\n",
2009 info->bt_prefix, my_db_strerror(Status)));
2010 if (Status)
2011 return RETVAL ;
2012 }
2013
2014 if (info->re_len) {
2015 Status = dbp->set_re_len(dbp, info->re_len) ;
2016 Trace(("set_re_len [%d] returned %s\n",
2017 info->re_len, my_db_strerror(Status)));
2018 if (Status)
2019 return RETVAL ;
2020 }
2021
2022 if (info->re_delim) {
2023 Status = dbp->set_re_delim(dbp, info->re_delim) ;
2024 Trace(("set_re_delim [%d] returned %s\n",
2025 info->re_delim, my_db_strerror(Status)));
2026 if (Status)
2027 return RETVAL ;
2028 }
2029
2030 if (info->re_pad) {
2031 Status = dbp->set_re_pad(dbp, info->re_pad) ;
2032 Trace(("set_re_pad [%d] returned %s\n",
2033 info->re_pad, my_db_strerror(Status)));
2034 if (Status)
2035 return RETVAL ;
2036 }
2037
2038 if (info->flags) {
2039 Status = dbp->set_flags(dbp, info->flags) ;
2040 Trace(("set_flags [%d] returned %s\n",
2041 info->flags, my_db_strerror(Status)));
2042 if (Status)
2043 return RETVAL ;
2044 }
2045
2046 if (info->q_extentsize) {
2047 #ifdef AT_LEAST_DB_3_2
2048 Status = dbp->set_q_extentsize(dbp, info->q_extentsize) ;
2049 Trace(("set_q_extentsize [%d] returned %s\n",
2050 info->q_extentsize, my_db_strerror(Status)));
2051 if (Status)
2052 return RETVAL ;
2053 #else
2054 softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ;
2055 #endif
2056 }
2057
2058 if (info->heapsize_bytes || info->heapsize_gbytes) {
2059 #ifdef AT_LEAST_DB_5_2
2060 Status = dbp->set_heapsize(dbp, info->heapsize_gbytes,
2061 info->heapsize_bytes,0) ;
2062 Trace(("set_heapsize [%d,%d] returned %s\n",
2063 info->heapsize_gbytes, info->heapsize_bytes, my_db_strerror(Status)));
2064 if (Status)
2065 return RETVAL ;
2066 #else
2067 softCrash("-HeapSize/HeapSizeGb needs at least Berkeley DB 5.2.x") ;
2068 #endif
2069 }
2070
2071 /* In-memory database need DB_CREATE from 4.4 */
2072 if (! file)
2073 flags |= DB_CREATE;
2074
2075 Trace(("db_open'ing\n"));
2076
2077 #ifdef AT_LEAST_DB_4_1
2078 if ((Status = (dbp->open)(dbp, txnid, file, subname, type, flags, mode)) == 0) {
2079 #else
2080 if ((Status = (dbp->open)(dbp, file, subname, type, flags, mode)) == 0) {
2081 #endif /* AT_LEAST_DB_4_1 */
2082 #else /* DB_VERSION_MAJOR == 2 */
2083 if ((Status = db_open(file, type, flags, mode, env, info, &dbp)) == 0) {
2084 CurrentDB = db ;
2085 #endif /* DB_VERSION_MAJOR == 2 */
2086
2087
2088 Trace(("db_opened ok\n"));
2089 RETVAL = db ;
2090 RETVAL->dbp = dbp ;
2091 RETVAL->txn = txnid ;
2092 #if DB_VERSION_MAJOR == 2
2093 RETVAL->type = dbp->type ;
2094 #else /* DB_VERSION_MAJOR > 2 */
2095 #ifdef AT_LEAST_DB_3_3
2096 dbp->get_type(dbp, &RETVAL->type) ;
2097 #else /* DB 3.0 -> 3.2 */
2098 RETVAL->type = dbp->get_type(dbp) ;
2099 #endif
2100 #endif /* DB_VERSION_MAJOR > 2 */
2101 RETVAL->primary_recno_or_queue = FALSE;
2102 RETVAL->recno_or_queue = (RETVAL->type == DB_RECNO ||
2103 RETVAL->type == DB_QUEUE) ;
2104 RETVAL->filename = my_strdup(file) ;
2105 RETVAL->Status = Status ;
2106 RETVAL->active = TRUE ;
2107 hash_store_iv("BerkeleyDB::Term::Db", (char *)RETVAL, 1) ;
2108 Trace((" storing %p %p in BerkeleyDB::Term::Db\n", RETVAL, dbp)) ;
2109 if (dbenv) {
2110 RETVAL->cds_enabled = dbenv->cds_enabled ;
2111 RETVAL->parent_env = dbenv ;
2112 dbenv->Status = Status ;
2113 ++ dbenv->open_dbs ;
2114 }
2115 }
2116 else {
2117 #if DB_VERSION_MAJOR > 2
2118 (dbp->close)(dbp, 0) ;
2119 #endif
2120 destroyDB(db) ;
2121 Trace(("db open returned %s\n", my_db_strerror(Status))) ;
2122 }
2123
2124 Trace(("End of _db_open\n"));
2125 return RETVAL ;
2126 }
2127
2128
2129 #include "constants.h"
2130
2131 MODULE = BerkeleyDB PACKAGE = BerkeleyDB PREFIX = env_
2132
2133 INCLUDE: constants.xs
2134
2135 #define env_db_version(maj, min, patch) db_version(&maj, &min, &patch)
2136 char *
2137 env_db_version(maj, min, patch)
2138 int maj
2139 int min
2140 int patch
2141 PREINIT:
2142 dMY_CXT;
2143 OUTPUT:
2144 RETVAL
2145 maj
2146 min
2147 patch
2148
2149 int has_heap()
2150 CODE:
2151 #ifdef AT_LEAST_DB_5_2
2152 RETVAL = __heap_exist() ;
2153 #else
2154 RETVAL = 0 ;
2155 #endif
2156 OUTPUT:
2157 RETVAL
2158
2159
2160
2161 int
2162 db_value_set(value, which)
2163 int value
2164 int which
2165 NOT_IMPLEMENTED_YET
2166
2167
2168 DualType
2169 _db_remove(ref)
2170 SV * ref
2171 PREINIT:
2172 dMY_CXT;
2173 CODE:
2174 {
2175 #if DB_VERSION_MAJOR == 2
2176 softCrash("BerkeleyDB::db_remove needs Berkeley DB 3.x or better") ;
2177 #else
2178 HV * hash ;
2179 DB * dbp ;
2180 SV * sv ;
2181 const char * db = NULL ;
2182 const char * subdb = NULL ;
2183 BerkeleyDB__Env env = NULL ;
2184 BerkeleyDB__Txn txn = NULL ;
2185 DB_ENV * dbenv = NULL ;
2186 u_int32_t flags = 0 ;
2187
2188 hash = (HV*) SvRV(ref) ;
2189 SetValue_pv(db, "Filename", char *) ;
2190 SetValue_pv(subdb, "Subname", char *) ;
2191 SetValue_iv(flags, "Flags") ;
2192 SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2193 if (txn) {
2194 #ifdef AT_LEAST_DB_4_1
2195 if (!env)
2196 softCrash("transactional db_remove requires an environment");
2197 RETVAL = env->Status = env->Env->dbremove(env->Env, txn->txn, db, subdb, flags);
2198 #else
2199 softCrash("transactional db_remove requires Berkeley DB 4.1 or better");
2200 #endif
2201 } else {
2202 if (env)
2203 dbenv = env->Env ;
2204 RETVAL = db_create(&dbp, dbenv, 0) ;
2205 if (RETVAL == 0) {
2206 RETVAL = dbp->remove(dbp, db, subdb, flags) ;
2207 }
2208 }
2209 #endif
2210 }
2211 OUTPUT:
2212 RETVAL
2213
2214 DualType
2215 _db_verify(ref)
2216 SV * ref
2217 PREINIT:
2218 dMY_CXT;
2219 CODE:
2220 {
2221 #ifndef AT_LEAST_DB_3_1
2222 softCrash("BerkeleyDB::db_verify needs Berkeley DB 3.1.x or better") ;
2223 #else
2224 HV * hash ;
2225 DB * dbp ;
2226 SV * sv ;
2227 const char * db = NULL ;
2228 const char * subdb = NULL ;
2229 const char * outfile = NULL ;
2230 FILE * ofh = NULL;
2231 BerkeleyDB__Env env = NULL ;
2232 DB_ENV * dbenv = NULL ;
2233 u_int32_t flags = 0 ;
2234
2235 hash = (HV*) SvRV(ref) ;
2236 SetValue_pv(db, "Filename", char *) ;
2237 SetValue_pv(subdb, "Subname", char *) ;
2238 SetValue_pv(outfile, "Outfile", char *) ;
2239 SetValue_iv(flags, "Flags") ;
2240 SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2241 RETVAL = 0;
2242 if (outfile){
2243 ofh = fopen(outfile, "w");
2244 if (! ofh)
2245 RETVAL = errno;
2246 }
2247 if (! RETVAL) {
2248 if (env)
2249 dbenv = env->Env ;
2250 RETVAL = db_create(&dbp, dbenv, 0) ;
2251 if (RETVAL == 0) {
2252 RETVAL = dbp->verify(dbp, db, subdb, ofh, flags) ;
2253 }
2254 if (outfile)
2255 fclose(ofh);
2256 }
2257 #endif
2258 }
2259 OUTPUT:
2260 RETVAL
2261
2262 DualType
2263 _db_rename(ref)
2264 SV * ref
2265 PREINIT:
2266 dMY_CXT;
2267 CODE:
2268 {
2269 #ifndef AT_LEAST_DB_3_1
2270 softCrash("BerkeleyDB::db_rename needs Berkeley DB 3.1.x or better") ;
2271 #else
2272 HV * hash ;
2273 DB * dbp ;
2274 SV * sv ;
2275 const char * db = NULL ;
2276 const char * subdb = NULL ;
2277 const char * newname = NULL ;
2278 BerkeleyDB__Env env = NULL ;
2279 BerkeleyDB__Txn txn = NULL ;
2280 DB_ENV * dbenv = NULL ;
2281 u_int32_t flags = 0 ;
2282
2283 hash = (HV*) SvRV(ref) ;
2284 SetValue_pv(db, "Filename", char *) ;
2285 SetValue_pv(subdb, "Subname", char *) ;
2286 SetValue_pv(newname, "Newname", char *) ;
2287 SetValue_iv(flags, "Flags") ;
2288 SetValue_ov(env, "Env", BerkeleyDB__Env) ;
2289 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
2290 if (txn) {
2291 #ifdef AT_LEAST_DB_4_1
2292 if (!env)
2293 softCrash("transactional db_rename requires an environment");
2294 RETVAL = env->Status = env->Env->dbrename(env->Env, txn->txn, db, subdb, newname, flags);
2295 #else
2296 softCrash("transactional db_rename requires Berkeley DB 4.1 or better");
2297 #endif
2298 } else {
2299 if (env)
2300 dbenv = env->Env ;
2301 RETVAL = db_create(&dbp, dbenv, 0) ;
2302 if (RETVAL == 0) {
2303 RETVAL = (dbp->rename)(dbp, db, subdb, newname, flags) ;
2304 }
2305 }
2306 #endif
2307 }
2308 OUTPUT:
2309 RETVAL
2310
2311 MODULE = BerkeleyDB::Env PACKAGE = BerkeleyDB::Env PREFIX = env_
2312
2313 BerkeleyDB::Env::Raw
2314 create(flags=0)
2315 u_int32_t flags
2316 PREINIT:
2317 dMY_CXT;
2318 CODE:
2319 {
2320 #ifndef AT_LEAST_DB_4_1
2321 softCrash("$env->create needs Berkeley DB 4.1 or better") ;
2322 #else
2323 DB_ENV * env ;
2324 int status;
2325 RETVAL = NULL;
2326 Trace(("in BerkeleyDB::Env::create flags=%d\n", flags)) ;
2327 status = db_env_create(&env, flags) ;
2328 Trace(("db_env_create returned %s\n", my_db_strerror(status))) ;
2329 if (status == 0) {
2330 ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
2331 RETVAL->Env = env ;
2332 RETVAL->active = TRUE ;
2333 RETVAL->opened = FALSE;
2334 env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
2335 env->set_errcall(env, db_errcall_cb) ;
2336 }
2337 #endif
2338 }
2339 OUTPUT:
2340 RETVAL
2341
2342 int
2343 open(env, db_home=NULL, flags=0, mode=0777)
2344 BerkeleyDB::Env env
2345 char * db_home
2346 u_int32_t flags
2347 int mode
2348 PREINIT:
2349 dMY_CXT;
2350 CODE:
2351 #ifndef AT_LEAST_DB_4_1
2352 softCrash("$env->create needs Berkeley DB 4.1 or better") ;
2353 #else
2354 RETVAL = env->Env->open(env->Env, db_home, flags, mode);
2355 env->opened = TRUE;
2356 #endif
2357 OUTPUT:
2358 RETVAL
2359
2360 bool
2361 cds_enabled(env)
2362 BerkeleyDB::Env env
2363 PREINIT:
2364 dMY_CXT;
2365 CODE:
2366 RETVAL = env->cds_enabled ;
2367 OUTPUT:
2368 RETVAL
2369
2370
2371 int
2372 set_encrypt(env, passwd, flags)
2373 BerkeleyDB::Env env
2374 const char * passwd
2375 u_int32_t flags
2376 PREINIT:
2377 dMY_CXT;
2378 CODE:
2379 #ifndef AT_LEAST_DB_4_1
2380 softCrash("$env->set_encrypt needs Berkeley DB 4.1 or better") ;
2381 #else
2382 dieIfEnvOpened(env, "set_encrypt");
2383 RETVAL = env->Env->set_encrypt(env->Env, passwd, flags);
2384 env->opened = TRUE;
2385 #endif
2386 OUTPUT:
2387 RETVAL
2388
2389
2390
2391
2392 BerkeleyDB::Env::Raw
2393 _db_appinit(self, ref, errfile=NULL)
2394 char * self
2395 SV * ref
2396 SV * errfile
2397 PREINIT:
2398 dMY_CXT;
2399 CODE:
2400 {
2401 HV * hash ;
2402 SV * sv ;
2403 char * enc_passwd = NULL ;
2404 int enc_flags = 0 ;
2405 char * home = NULL ;
2406 char * server = NULL ;
2407 char ** config = NULL ;
2408 int flags = 0 ;
2409 int setflags = 0 ;
2410 int cachesize = 0 ;
2411 int lk_detect = 0 ;
2412 int tx_max = 0 ;
2413 int log_config = 0 ;
2414 int max_lockers = 0 ;
2415 int max_locks = 0 ;
2416 int max_objects = 0 ;
2417 long shm_key = 0 ;
2418 char* data_dir = 0;
2419 char* log_dir = 0;
2420 char* temp_dir = 0;
2421 SV * msgfile = NULL ;
2422 int thread_count = 0 ;
2423 SV * errprefix = NULL;
2424 DB_ENV * env ;
2425 int status ;
2426
2427 Trace(("in _db_appinit [%s] %d\n", self, ref)) ;
2428 hash = (HV*) SvRV(ref) ;
2429 SetValue_pv(home, "Home", char *) ;
2430 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
2431 SetValue_iv(enc_flags, "Enc_Flags") ;
2432 SetValue_pv(config, "Config", char **) ;
2433 SetValue_sv(errprefix, "ErrPrefix") ;
2434 SetValue_iv(flags, "Flags") ;
2435 SetValue_iv(setflags, "SetFlags") ;
2436 SetValue_pv(server, "Server", char *) ;
2437 SetValue_iv(cachesize, "Cachesize") ;
2438 SetValue_iv(lk_detect, "LockDetect") ;
2439 SetValue_iv(tx_max, "TxMax") ;
2440 SetValue_iv(log_config,"LogConfig") ;
2441 SetValue_iv(max_lockers,"MaxLockers") ;
2442 SetValue_iv(max_locks, "MaxLocks") ;
2443 SetValue_iv(max_objects,"MaxObjects") ;
2444 SetValue_iv(shm_key, "SharedMemKey") ;
2445 SetValue_iv(thread_count, "ThreadCount") ;
2446 SetValue_pv(data_dir, "DB_DATA_DIR", char*) ;
2447 SetValue_pv(temp_dir, "DB_TEMP_DIR", char*) ;
2448 SetValue_pv(log_dir, "DB_LOG_DIR", char*) ;
2449 SetValue_sv(msgfile, "MsgFile") ;
2450 #ifndef AT_LEAST_DB_3_2
2451 if (setflags)
2452 softCrash("-SetFlags needs Berkeley DB 3.x or better") ;
2453 #endif /* ! AT_LEAST_DB_3 */
2454 #ifndef AT_LEAST_DB_3_1
2455 if (shm_key)
2456 softCrash("-SharedMemKey needs Berkeley DB 3.1 or better") ;
2457 #endif /* ! AT_LEAST_DB_3_1 */
2458 #if ! defined(AT_LEAST_DB_3_1) || defined(AT_LEAST_DB_5_1)
2459 if (server)
2460 softCrash("-Server only supported Berkeley DB 3.1 to 5.1") ;
2461 #endif /* ! AT_LEAST_DB_3_1 */
2462 #ifndef AT_LEAST_DB_3_2
2463 if (max_lockers)
2464 softCrash("-MaxLockers needs Berkeley DB 3.2 or better") ;
2465 if (max_locks)
2466 softCrash("-MaxLocks needs Berkeley DB 3.2 or better") ;
2467 if (max_objects)
2468 softCrash("-MaxObjects needs Berkeley DB 3.2 or better") ;
2469 #endif /* ! AT_LEAST_DB_3_2 */
2470 #ifndef AT_LEAST_DB_4_1
2471 if (enc_passwd)
2472 softCrash("-Encrypt needs Berkeley DB 4.x or better") ;
2473 #endif /* ! AT_LEAST_DB_4_1 */
2474 #ifndef AT_LEAST_DB_4_3
2475 if (msgfile)
2476 softCrash("-MsgFile needs Berkeley DB 4.3.x or better") ;
2477 #endif /* ! AT_LEAST_DB_4_3 */
2478 #ifdef _WIN32
2479 if (thread_count)
2480 softCrash("-ThreadCount not supported on Windows") ;
2481 #endif /* ! _WIN32 */
2482 #ifndef AT_LEAST_DB_4_4
2483 if (thread_count)
2484 softCrash("-ThreadCount needs Berkeley DB 4.4 or better") ;
2485 #endif /* ! AT_LEAST_DB_4_4 */
2486 #ifndef AT_LEAST_DB_4_7
2487 if (log_config)
2488 softCrash("-LogConfig needs Berkeley DB 4.7 or better") ;
2489 #endif /* ! AT_LEAST_DB_4_7 */
2490 Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n",
2491 config, home, errprefix, flags)) ;
2492 #ifdef TRACE
2493 if (config) {
2494 int i ;
2495 for (i = 0 ; i < 10 ; ++ i) {
2496 if (config[i] == NULL) {
2497 printf(" End\n") ;
2498 break ;
2499 }
2500 printf(" config = [%s]\n", config[i]) ;
2501 }
2502 }
2503 #endif /* TRACE */
2504 ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ;
2505 if (flags & DB_INIT_TXN)
2506 RETVAL->txn_enabled = TRUE ;
2507 #if DB_VERSION_MAJOR == 2
2508 ZMALLOC(RETVAL->Env, DB_ENV) ;
2509 env = RETVAL->Env ;
2510 {
2511 /* Take a copy of the error prefix */
2512 if (errprefix) {
2513 Trace(("copying errprefix\n" )) ;
2514 RETVAL->ErrPrefix = newSVsv(errprefix) ;
2515 SvPOK_only(RETVAL->ErrPrefix) ;
2516 }
2517 if (RETVAL->ErrPrefix)
2518 RETVAL->Env->db_errpfx = SvPVX(RETVAL->ErrPrefix) ;
2519
2520 if (SvGMAGICAL(errfile))
2521 mg_get(errfile);
2522 if (SvOK(errfile)) {
2523 FILE * ef = GetFILEptr(errfile) ;
2524 if (! ef)
2525 croak("Cannot open file ErrFile", Strerror(errno));
2526 RETVAL->ErrHandle = newSVsv(errfile) ;
2527 env->db_errfile = ef;
2528 }
2529 SetValue_iv(env->db_verbose, "Verbose") ;
2530 env->db_errcall = db_errcall_cb ;
2531 RETVAL->active = TRUE ;
2532 RETVAL->opened = TRUE;
2533 RETVAL->cds_enabled = ((flags & DB_INIT_CDB) != 0 ? TRUE : FALSE) ;
2534 status = db_appinit(home, config, env, flags) ;
2535 printf(" status = %d errno %d \n", status, errno) ;
2536 Trace((" status = %d env %d Env %d\n", status, RETVAL, env)) ;
2537 if (status == 0)
2538 hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
2539 else {
2540
2541 if (RETVAL->ErrHandle)
2542 SvREFCNT_dec(RETVAL->ErrHandle) ;
2543 if (RETVAL->ErrPrefix)
2544 SvREFCNT_dec(RETVAL->ErrPrefix) ;
2545 Safefree(RETVAL->Env) ;
2546 Safefree(RETVAL) ;
2547 RETVAL = NULL ;
2548 }
2549 }
2550 #else /* DB_VERSION_MAJOR > 2 */
2551 #ifndef AT_LEAST_DB_3_1
2552 # define DB_CLIENT 0
2553 #endif
2554 #ifdef AT_LEAST_DB_5_1
2555 # define DB_CLIENT 0
2556 #else
2557 # ifdef AT_LEAST_DB_4_2
2558 # define DB_CLIENT DB_RPCCLIENT
2559 # endif
2560 #endif
2561 status = db_env_create(&RETVAL->Env, server ? DB_CLIENT : 0) ;
2562 Trace(("db_env_create flags = %d returned %s\n", flags,
2563 my_db_strerror(status))) ;
2564 env = RETVAL->Env ;
2565 #ifdef AT_LEAST_DB_3_3
2566 env->set_alloc(env, safemalloc, MyRealloc, safefree) ;
2567 #endif
2568 #ifdef AT_LEAST_DB_3_1
2569 if (status == 0 && shm_key) {
2570 status = env->set_shm_key(env, shm_key) ;
2571 Trace(("set_shm_key [%d] returned %s\n", shm_key,
2572 my_db_strerror(status)));
2573 }
2574
2575 if (status == 0 && data_dir) {
2576 status = env->set_data_dir(env, data_dir) ;
2577 Trace(("set_data_dir [%s] returned %s\n", data_dir,
2578 my_db_strerror(status)));
2579 }
2580
2581 if (status == 0 && temp_dir) {
2582 status = env->set_tmp_dir(env, temp_dir) ;
2583 Trace(("set_tmp_dir [%s] returned %s\n", temp_dir,
2584 my_db_strerror(status)));
2585 }
2586
2587 if (status == 0 && log_dir) {
2588 status = env->set_lg_dir(env, log_dir) ;
2589 Trace(("set_lg_dir [%s] returned %s\n", log_dir,
2590 my_db_strerror(status)));
2591 }
2592 #endif
2593 if (status == 0 && cachesize) {
2594 status = env->set_cachesize(env, 0, cachesize, 0) ;
2595 Trace(("set_cachesize [%d] returned %s\n",
2596 cachesize, my_db_strerror(status)));
2597 }
2598
2599 if (status == 0 && lk_detect) {
2600 status = env->set_lk_detect(env, lk_detect) ;
2601 Trace(("set_lk_detect [%d] returned %s\n",
2602 lk_detect, my_db_strerror(status)));
2603 }
2604
2605 if (status == 0 && tx_max) {
2606 status = env->set_tx_max(env, tx_max) ;
2607 Trace(("set_tx_max [%d] returned %s\n",
2608 tx_max, my_db_strerror(status)));
2609 }
2610 #ifdef AT_LEAST_DB_4_7
2611 if (status == 0 && log_config) {
2612 status = env->log_set_config(env, log_config, 1) ;
2613 Trace(("log_set_config [%d] returned %s\n",
2614 log_config, my_db_strerror(status)));
2615 }
2616 #endif /* AT_LEAST_DB_4_7 */
2617 #ifdef AT_LEAST_DB_3_2
2618 if (status == 0 && max_lockers) {
2619 status = env->set_lk_max_lockers(env, max_lockers) ;
2620 Trace(("set_lk_max_lockers [%d] returned %s\n",
2621 max_lockers, my_db_strerror(status)));
2622 }
2623
2624 if (status == 0 && max_locks) {
2625 status = env->set_lk_max_locks(env, max_locks) ;
2626 Trace(("set_lk_max_locks [%d] returned %s\n",
2627 max_locks, my_db_strerror(status)));
2628 }
2629
2630 if (status == 0 && max_objects) {
2631 status = env->set_lk_max_objects(env, max_objects) ;
2632 Trace(("set_lk_max_objects [%d] returned %s\n",
2633 max_objects, my_db_strerror(status)));
2634 }
2635 #endif /* AT_LEAST_DB_3_2 */
2636 #ifdef AT_LEAST_DB_4_1
2637 /* set encryption */
2638 if (enc_passwd && status == 0)
2639 {
2640 status = env->set_encrypt(env, enc_passwd, enc_flags);
2641 Trace(("ENV->set_encrypt passwd = %s, flags %d returned %s\n",
2642 enc_passwd, enc_flags,
2643 my_db_strerror(status))) ;
2644 }
2645 #endif
2646 #if ! defined(AT_LEAST_DB_5_1)
2647 #ifdef AT_LEAST_DB_4
2648 /* set the server */
2649 if (server && status == 0)
2650 {
2651 status = env->set_rpc_server(env, NULL, server, 0, 0, 0);
2652 Trace(("ENV->set_rpc_server server = %s returned %s\n", server,
2653 my_db_strerror(status))) ;
2654 }
2655 #else
2656 # if defined(AT_LEAST_DB_3_1) && ! defined(AT_LEAST_DB_4)
2657 /* set the server */
2658 if (server && status == 0)
2659 {
2660 status = env->set_server(env, server, 0, 0, 0);
2661 Trace(("ENV->set_server server = %s returned %s\n", server,
2662 my_db_strerror(status))) ;
2663 }
2664 # endif
2665 #endif
2666 #endif
2667 #ifdef AT_LEAST_DB_3_2
2668 if (setflags && status == 0)
2669 {
2670 status = env->set_flags(env, setflags, 1);
2671 Trace(("ENV->set_flags value = %d returned %s\n", setflags,
2672 my_db_strerror(status))) ;
2673 }
2674 #endif
2675 #if defined(AT_LEAST_DB_4_4) && ! defined(_WIN32)
2676 if (thread_count && status == 0)
2677 {
2678 status = env->set_thread_count(env, thread_count);
2679 Trace(("ENV->set_thread_count value = %d returned %s\n", thread_count,
2680 my_db_strerror(status))) ;
2681 }
2682 #endif
2683
2684 if (status == 0)
2685 {
2686 int mode = 0 ;
2687 /* Take a copy of the error prefix */
2688 if (errprefix) {
2689 Trace(("copying errprefix\n" )) ;
2690 RETVAL->ErrPrefix = newSVsv(errprefix) ;
2691 SvPOK_only(RETVAL->ErrPrefix) ;
2692 }
2693 if (RETVAL->ErrPrefix)
2694 env->set_errpfx(env, SvPVX(RETVAL->ErrPrefix)) ;
2695
2696 if (SvGMAGICAL(errfile))
2697 mg_get(errfile);
2698 if (SvOK(errfile)) {
2699 FILE * ef = GetFILEptr(errfile);
2700 if (! ef)
2701 croak("Cannot open file ErrFile", Strerror(errno));
2702 RETVAL->ErrHandle = newSVsv(errfile) ;
2703 env->set_errfile(env, ef) ;
2704
2705 }
2706 #ifdef AT_LEAST_DB_4_3
2707 if (msgfile) {
2708 if (SvGMAGICAL(msgfile))
2709 mg_get(msgfile);
2710 if (SvOK(msgfile)) {
2711 FILE * ef = GetFILEptr(msgfile);
2712 if (! ef)
2713 croak("Cannot open file MsgFile", Strerror(errno));
2714 RETVAL->MsgHandle = newSVsv(msgfile) ;
2715 env->set_msgfile(env, ef) ;
2716 }
2717 }
2718 #endif
2719 SetValue_iv(mode, "Mode") ;
2720 env->set_errcall(env, db_errcall_cb) ;
2721 RETVAL->active = TRUE ;
2722 RETVAL->cds_enabled = ((flags & DB_INIT_CDB) != 0 ? TRUE : FALSE) ;
2723 #ifdef IS_DB_3_0_x
2724 status = (env->open)(env, home, config, flags, mode) ;
2725 #else /* > 3.0 */
2726 status = (env->open)(env, home, flags, mode) ;
2727 #endif
2728 Trace(("ENV->open(env=%s,home=%s,flags=%d,mode=%d)\n",env,home,flags,mode)) ;
2729 Trace(("ENV->open returned %s\n", my_db_strerror(status))) ;
2730 }
2731
2732 if (status == 0)
2733 hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ;
2734 else {
2735 (env->close)(env, 0) ;
2736 #ifdef AT_LEAST_DB_4_3
2737 if (RETVAL->MsgHandle)
2738 SvREFCNT_dec(RETVAL->MsgHandle) ;
2739 #endif
2740 if (RETVAL->ErrHandle)
2741 SvREFCNT_dec(RETVAL->ErrHandle) ;
2742 if (RETVAL->ErrPrefix)
2743 SvREFCNT_dec(RETVAL->ErrPrefix) ;
2744 Safefree(RETVAL) ;
2745 RETVAL = NULL ;
2746 }
2747 #endif /* DB_VERSION_MAJOR > 2 */
2748 {
2749 SV * sv_err = perl_get_sv(ERR_BUFF, FALSE);
2750 sv_setpv(sv_err, db_strerror(status));
2751 }
2752 }
2753 OUTPUT:
2754 RETVAL
2755
2756 DB_ENV*
2757 DB_ENV(env)
2758 BerkeleyDB::Env env
2759 PREINIT:
2760 dMY_CXT;
2761 CODE:
2762 if (env->active)
2763 RETVAL = env->Env ;
2764 else
2765 RETVAL = NULL;
2766 OUTPUT:
2767 RETVAL
2768
2769
2770 void
2771 log_archive(env, flags=0)
2772 u_int32_t flags
2773 BerkeleyDB::Env env
2774 PREINIT:
2775 dMY_CXT;
2776 PPCODE:
2777 {
2778 char ** list;
2779 char ** file;
2780 AV * av;
2781 #ifndef AT_LEAST_DB_3
2782 softCrash("log_archive needs at least Berkeley DB 3.x.x");
2783 #else
2784 # ifdef AT_LEAST_DB_4
2785 env->Status = env->Env->log_archive(env->Env, &list, flags) ;
2786 # else
2787 # ifdef AT_LEAST_DB_3_3
2788 env->Status = log_archive(env->Env, &list, flags) ;
2789 # else
2790 env->Status = log_archive(env->Env, &list, flags, safemalloc) ;
2791 # endif
2792 # endif
2793 #ifdef DB_ARCH_REMOVE
2794 if (env->Status == 0 && list != NULL && flags != DB_ARCH_REMOVE)
2795 #else
2796 if (env->Status == 0 && list != NULL )
2797 #endif
2798 {
2799 for (file = list; *file != NULL; ++file)
2800 {
2801 XPUSHs(sv_2mortal(newSVpv(*file, 0))) ;
2802 }
2803 safefree(list);
2804 }
2805 #endif
2806 }
2807
2808 DualType
2809 log_set_config(env, flags=0, onoff=0)
2810 BerkeleyDB::Env env
2811 u_int32_t flags
2812 int onoff
2813 PREINIT:
2814 dMY_CXT;
2815 CODE:
2816 {
2817 #ifndef AT_LEAST_DB_4_7
2818 softCrash("log_set_config needs at least Berkeley DB 4.7.x");
2819 #else
2820 RETVAL = env->Status = env->Env->log_set_config(env->Env, flags, onoff) ;
2821 #endif
2822 }
2823 OUTPUT:
2824 RETVAL
2825
2826 DualType
2827 log_get_config(env, flags, onoff)
2828 BerkeleyDB::Env env
2829 u_int32_t flags
2830 int onoff=NO_INIT
2831 PREINIT:
2832 dMY_CXT;
2833 CODE:
2834 {
2835 #ifndef AT_LEAST_DB_4_7
2836 softCrash("log_get_config needs at least Berkeley DB 4.7.x");
2837 #else
2838 RETVAL = env->Status = env->Env->log_get_config(env->Env, flags, &onoff) ;
2839 #endif
2840 }
2841 OUTPUT:
2842 RETVAL
2843 onoff
2844
2845
2846 BerkeleyDB::Txn::Raw
2847 _txn_begin(env, pid=NULL, flags=0)
2848 u_int32_t flags
2849 BerkeleyDB::Env env
2850 BerkeleyDB::Txn pid
2851 PREINIT:
2852 dMY_CXT;
2853 CODE:
2854 {
2855 DB_TXN *txn ;
2856 DB_TXN *p_id = NULL ;
2857 Trace(("txn_begin pid %d, flags %d\n", pid, flags)) ;
2858 #if DB_VERSION_MAJOR == 2
2859 if (env->Env->tx_info == NULL)
2860 softCrash("Transaction Manager not enabled") ;
2861 #endif
2862 if (!env->txn_enabled)
2863 softCrash("Transaction Manager not enabled") ;
2864 if (pid)
2865 p_id = pid->txn ;
2866 env->TxnMgrStatus =
2867 #if DB_VERSION_MAJOR == 2
2868 txn_begin(env->Env->tx_info, p_id, &txn) ;
2869 #else
2870 # ifdef AT_LEAST_DB_4
2871 env->Env->txn_begin(env->Env, p_id, &txn, flags) ;
2872 # else
2873 txn_begin(env->Env, p_id, &txn, flags) ;
2874 # endif
2875 #endif
2876 if (env->TxnMgrStatus == 0) {
2877 ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
2878 RETVAL->txn = txn ;
2879 RETVAL->active = TRUE ;
2880 Trace(("_txn_begin created txn [%p] in [%p]\n", txn, RETVAL));
2881 hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
2882 }
2883 else
2884 RETVAL = NULL ;
2885 }
2886 OUTPUT:
2887 RETVAL
2888
2889
2890 #if DB_VERSION_MAJOR == 2
2891 # define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env->tx_info, k, m)
2892 #else /* DB 3.0 or better */
2893 # ifdef AT_LEAST_DB_4
2894 # define env_txn_checkpoint(e,k,m,f) e->Env->txn_checkpoint(e->Env, k, m, f)
2895 # else
2896 # ifdef AT_LEAST_DB_3_1
2897 # define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m, 0)
2898 # else
2899 # define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m)
2900 # endif
2901 # endif
2902 #endif
2903 DualType
2904 env_txn_checkpoint(env, kbyte, min, flags=0)
2905 BerkeleyDB::Env env
2906 long kbyte
2907 long min
2908 u_int32_t flags
2909 PREINIT:
2910 dMY_CXT;
2911
2912 HV *
2913 txn_stat(env)
2914 BerkeleyDB::Env env
2915 HV * RETVAL = NULL ;
2916 PREINIT:
2917 dMY_CXT;
2918 CODE:
2919 {
2920 DB_TXN_STAT * stat ;
2921 #ifdef AT_LEAST_DB_4
2922 if(env->Env->txn_stat(env->Env, &stat, 0) == 0) {
2923 #else
2924 # ifdef AT_LEAST_DB_3_3
2925 if(txn_stat(env->Env, &stat) == 0) {
2926 # else
2927 # if DB_VERSION_MAJOR == 2
2928 if(txn_stat(env->Env->tx_info, &stat, safemalloc) == 0) {
2929 # else
2930 if(txn_stat(env->Env, &stat, safemalloc) == 0) {
2931 # endif
2932 # endif
2933 #endif
2934 RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
2935 hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
2936 hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
2937 hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
2938 hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
2939 hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
2940 hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
2941 hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
2942 #if DB_VERSION_MAJOR > 2
2943 hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
2944 hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
2945 hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
2946 hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
2947 #endif
2948 safefree(stat) ;
2949 }
2950 }
2951 OUTPUT:
2952 RETVAL
2953
2954 #define EnDis(x) ((x) ? "Enabled" : "Disabled")
2955 void
2956 printEnv(env)
2957 BerkeleyDB::Env env
2958 PREINIT:
2959 dMY_CXT;
2960 INIT:
2961 ckActive_Environment(env->active) ;
2962 CODE:
2963 #if 0
2964 printf("env [0x%X]\n", env) ;
2965 printf(" ErrPrefix [%s]\n", env->ErrPrefix
2966 ? SvPVX(env->ErrPrefix) : 0) ;
2967 printf(" DB_ENV\n") ;
2968 printf(" db_lorder [%d]\n", env->Env.db_lorder) ;
2969 printf(" db_home [%s]\n", env->Env.db_home) ;
2970 printf(" db_data_dir [%s]\n", env->Env.db_data_dir) ;
2971 printf(" db_log_dir [%s]\n", env->Env.db_log_dir) ;
2972 printf(" db_tmp_dir [%s]\n", env->Env.db_tmp_dir) ;
2973 printf(" lk_info [%s]\n", EnDis(env->Env.lk_info)) ;
2974 printf(" lk_max [%d]\n", env->Env.lk_max) ;
2975 printf(" lg_info [%s]\n", EnDis(env->Env.lg_info)) ;
2976 printf(" lg_max [%d]\n", env->Env.lg_max) ;
2977 printf(" mp_info [%s]\n", EnDis(env->Env.mp_info)) ;
2978 printf(" mp_size [%d]\n", env->Env.mp_size) ;
2979 printf(" tx_info [%s]\n", EnDis(env->Env.tx_info)) ;
2980 printf(" tx_max [%d]\n", env->Env.tx_max) ;
2981 printf(" flags [%d]\n", env->Env.flags) ;
2982 printf("\n") ;
2983 #endif
2984
2985 SV *
2986 errPrefix(env, prefix)
2987 BerkeleyDB::Env env
2988 SV * prefix
2989 PREINIT:
2990 dMY_CXT;
2991 INIT:
2992 ckActive_Environment(env->active) ;
2993 CODE:
2994 if (env->ErrPrefix) {
2995 RETVAL = newSVsv(env->ErrPrefix) ;
2996 SvPOK_only(RETVAL) ;
2997 sv_setsv(env->ErrPrefix, prefix) ;
2998 }
2999 else {
3000 RETVAL = NULL ;
3001 env->ErrPrefix = newSVsv(prefix) ;
3002 }
3003 SvPOK_only(env->ErrPrefix) ;
3004 #if DB_VERSION_MAJOR == 2
3005 env->Env->db_errpfx = SvPVX(env->ErrPrefix) ;
3006 #else
3007 env->Env->set_errpfx(env->Env, SvPVX(env->ErrPrefix)) ;
3008 #endif
3009 OUTPUT:
3010 RETVAL
3011
3012 DualType
3013 status(env)
3014 BerkeleyDB::Env env
3015 PREINIT:
3016 dMY_CXT;
3017 CODE:
3018 RETVAL = env->Status ;
3019 OUTPUT:
3020 RETVAL
3021
3022
3023
3024 DualType
3025 db_appexit(env)
3026 BerkeleyDB::Env env
3027 PREINIT:
3028 dMY_CXT;
3029 ALIAS: close =1
3030 INIT:
3031 ckActive_Environment(env->active) ;
3032 CODE:
3033 #ifdef STRICT_CLOSE
3034 if (env->open_dbs)
3035 softCrash("attempted to close an environment with %d open database(s)",
3036 env->open_dbs) ;
3037 #endif /* STRICT_CLOSE */
3038 #if DB_VERSION_MAJOR == 2
3039 RETVAL = db_appexit(env->Env) ;
3040 #else
3041 RETVAL = (env->Env->close)(env->Env, 0) ;
3042 #endif
3043 env->active = FALSE ;
3044 hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
3045 OUTPUT:
3046 RETVAL
3047
3048
3049 void
3050 _DESTROY(env)
3051 BerkeleyDB::Env env
3052 int RETVAL = 0 ;
3053 PREINIT:
3054 dMY_CXT;
3055 CODE:
3056 Trace(("In BerkeleyDB::Env::DESTROY\n"));
3057 Trace((" env %ld Env %ld dirty %d\n", env, &env->Env, PL_dirty)) ;
3058 if (env->active)
3059 #if DB_VERSION_MAJOR == 2
3060 db_appexit(env->Env) ;
3061 #else
3062 (env->Env->close)(env->Env, 0) ;
3063 #endif
3064 if (env->ErrHandle)
3065 SvREFCNT_dec(env->ErrHandle) ;
3066 #ifdef AT_LEAST_DB_4_3
3067 if (env->MsgHandle)
3068 SvREFCNT_dec(env->MsgHandle) ;
3069 #endif
3070 if (env->ErrPrefix)
3071 SvREFCNT_dec(env->ErrPrefix) ;
3072 #if DB_VERSION_MAJOR == 2
3073 Safefree(env->Env) ;
3074 #endif
3075 Safefree(env) ;
3076 hash_delete("BerkeleyDB::Term::Env", (char *)env) ;
3077 Trace(("End of BerkeleyDB::Env::DESTROY %d\n", RETVAL)) ;
3078
3079 BerkeleyDB::TxnMgr::Raw
3080 _TxnMgr(env)
3081 BerkeleyDB::Env env
3082 PREINIT:
3083 dMY_CXT;
3084 INIT:
3085 ckActive_Environment(env->active) ;
3086 if (!env->txn_enabled)
3087 softCrash("Transaction Manager not enabled") ;
3088 CODE:
3089 ZMALLOC(RETVAL, BerkeleyDB_TxnMgr_type) ;
3090 RETVAL->env = env ;
3091 /* hash_store_iv("BerkeleyDB::Term::TxnMgr", (char *)txn, 1) ; */
3092 OUTPUT:
3093 RETVAL
3094
3095 int
3096 get_shm_key(env, id)
3097 BerkeleyDB::Env env
3098 long id = NO_INIT
3099 PREINIT:
3100 dMY_CXT;
3101 INIT:
3102 ckActive_Database(env->active) ;
3103 CODE:
3104 #ifndef AT_LEAST_DB_4_2
3105 softCrash("$env->get_shm_key needs Berkeley DB 4.2 or better") ;
3106 #else
3107 RETVAL = env->Env->get_shm_key(env->Env, &id);
3108 #endif
3109 OUTPUT:
3110 RETVAL
3111 id
3112
3113
3114 int
3115 set_lg_dir(env, dir)
3116 BerkeleyDB::Env env
3117 char * dir
3118 PREINIT:
3119 dMY_CXT;
3120 INIT:
3121 ckActive_Database(env->active) ;
3122 CODE:
3123 #ifndef AT_LEAST_DB_3_1
3124 softCrash("$env->set_lg_dir needs Berkeley DB 3.1 or better") ;
3125 #else
3126 RETVAL = env->Status = env->Env->set_lg_dir(env->Env, dir);
3127 #endif
3128 OUTPUT:
3129 RETVAL
3130
3131 int
3132 set_lg_bsize(env, bsize)
3133 BerkeleyDB::Env env
3134 u_int32_t bsize
3135 PREINIT:
3136 dMY_CXT;
3137 INIT:
3138 ckActive_Database(env->active) ;
3139 CODE:
3140 #ifndef AT_LEAST_DB_3
3141 softCrash("$env->set_lg_bsize needs Berkeley DB 3.0.55 or better") ;
3142 #else
3143 RETVAL = env->Status = env->Env->set_lg_bsize(env->Env, bsize);
3144 #endif
3145 OUTPUT:
3146 RETVAL
3147
3148 int
3149 set_lg_max(env, lg_max)
3150 BerkeleyDB::Env env
3151 u_int32_t lg_max
3152 PREINIT:
3153 dMY_CXT;
3154 INIT:
3155 ckActive_Database(env->active) ;
3156 CODE:
3157 #ifndef AT_LEAST_DB_3
3158 softCrash("$env->set_lg_max needs Berkeley DB 3.0.55 or better") ;
3159 #else
3160 RETVAL = env->Status = env->Env->set_lg_max(env->Env, lg_max);
3161 #endif
3162 OUTPUT:
3163 RETVAL
3164
3165 int
3166 set_data_dir(env, dir)
3167 BerkeleyDB::Env env
3168 char * dir
3169 PREINIT:
3170 dMY_CXT;
3171 INIT:
3172 ckActive_Database(env->active) ;
3173 CODE:
3174 #ifndef AT_LEAST_DB_3_1
3175 softCrash("$env->set_data_dir needs Berkeley DB 3.1 or better") ;
3176 #else
3177 dieIfEnvOpened(env, "set_data_dir");
3178 RETVAL = env->Status = env->Env->set_data_dir(env->Env, dir);
3179 #endif
3180 OUTPUT:
3181 RETVAL
3182
3183 int
3184 set_tmp_dir(env, dir)
3185 BerkeleyDB::Env env
3186 char * dir
3187 PREINIT:
3188 dMY_CXT;
3189 INIT:
3190 ckActive_Database(env->active) ;
3191 CODE:
3192 #ifndef AT_LEAST_DB_3_1
3193 softCrash("$env->set_tmp_dir needs Berkeley DB 3.1 or better") ;
3194 #else
3195 RETVAL = env->Status = env->Env->set_tmp_dir(env->Env, dir);
3196 #endif
3197 OUTPUT:
3198 RETVAL
3199
3200 int
3201 set_mutexlocks(env, do_lock)
3202 BerkeleyDB::Env env
3203 int do_lock
3204 PREINIT:
3205 dMY_CXT;
3206 INIT:
3207 ckActive_Database(env->active) ;
3208 CODE:
3209 #ifndef AT_LEAST_DB_3
3210 softCrash("$env->set_setmutexlocks needs Berkeley DB 3.0 or better") ;
3211 #else
3212 # ifdef AT_LEAST_DB_4
3213 RETVAL = env->Status = env->Env->set_flags(env->Env, DB_NOLOCKING, !do_lock);
3214 # else
3215 # if defined(AT_LEAST_DB_3_2_6) || defined(IS_DB_3_0_x)
3216 RETVAL = env->Status = env->Env->set_mutexlocks(env->Env, do_lock);
3217 # else /* DB 3.1 or 3.2.3 */
3218 RETVAL = env->Status = db_env_set_mutexlocks(do_lock);
3219 # endif
3220 # endif
3221 #endif
3222 OUTPUT:
3223 RETVAL
3224
3225 int
3226 set_verbose(env, which, onoff)
3227 BerkeleyDB::Env env
3228 u_int32_t which
3229 int onoff
3230 PREINIT:
3231 dMY_CXT;
3232 INIT:
3233 ckActive_Database(env->active) ;
3234 CODE:
3235 #ifndef AT_LEAST_DB_3
3236 softCrash("$env->set_verbose needs Berkeley DB 3.x or better") ;
3237 #else
3238 RETVAL = env->Status = env->Env->set_verbose(env->Env, which, onoff);
3239 #endif
3240 OUTPUT:
3241 RETVAL
3242
3243 int
3244 set_flags(env, flags, onoff)
3245 BerkeleyDB::Env env
3246 u_int32_t flags
3247 int onoff
3248 PREINIT:
3249 dMY_CXT;
3250 INIT:
3251 ckActive_Database(env->active) ;
3252 CODE:
3253 #ifndef AT_LEAST_DB_3_2
3254 softCrash("$env->set_flags needs Berkeley DB 3.2.x or better") ;
3255 #else
3256 RETVAL = env->Status = env->Env->set_flags(env->Env, flags, onoff);
3257 #endif
3258 OUTPUT:
3259 RETVAL
3260
3261 int
3262 lsn_reset(env, file, flags)
3263 BerkeleyDB::Env env
3264 char* file
3265 u_int32_t flags
3266 PREINIT:
3267 dMY_CXT;
3268 INIT:
3269 ckActive_Database(env->active) ;
3270 CODE:
3271 #ifndef AT_LEAST_DB_4_3
3272 softCrash("$env->lsn_reset needs Berkeley DB 4.3.x or better") ;
3273 #else
3274 RETVAL = env->Status = env->Env->lsn_reset(env->Env, file, flags);
3275 #endif
3276 OUTPUT:
3277 RETVAL
3278
3279 int
3280 lock_detect(env, atype=DB_LOCK_DEFAULT, flags=0)
3281 BerkeleyDB::Env env
3282 u_int32_t atype
3283 u_int32_t flags
3284 PREINIT:
3285 dMY_CXT;
3286 INIT:
3287 ckActive_Database(env->active) ;
3288 CODE:
3289 #ifndef AT_LEAST_DB_2_2
3290 softCrash("$env->lock_detect needs Berkeley DB 2.2.x or better") ;
3291 #else
3292 RETVAL = env->Status = env->Env->lock_detect(env->Env,flags,atype,NULL);
3293 #endif
3294 OUTPUT:
3295 RETVAL
3296
3297
3298 int
3299 set_timeout(env, timeout, flags=0)
3300 BerkeleyDB::Env env
3301 db_timeout_t timeout
3302 u_int32_t flags
3303 PREINIT:
3304 dMY_CXT;
3305 INIT:
3306 ckActive_Database(env->active) ;
3307 CODE:
3308 #ifndef AT_LEAST_DB_4
3309 softCrash("$env->set_timeout needs Berkeley DB 4.x or better") ;
3310 #else
3311 RETVAL = env->Status = env->Env->set_timeout(env->Env, timeout, flags);
3312 #endif
3313 OUTPUT:
3314 RETVAL
3315
3316 int
3317 get_timeout(env, timeout, flags=0)
3318 BerkeleyDB::Env env
3319 db_timeout_t timeout = NO_INIT
3320 u_int32_t flags
3321 PREINIT:
3322 dMY_CXT;
3323 INIT:
3324 ckActive_Database(env->active) ;
3325 CODE:
3326 #ifndef AT_LEAST_DB_4_2
3327 softCrash("$env->set_timeout needs Berkeley DB 4.2.x or better") ;
3328 #else
3329 RETVAL = env->Status = env->Env->get_timeout(env->Env, &timeout, flags);
3330 #endif
3331 OUTPUT:
3332 RETVAL
3333 timeout
3334
3335 int
3336 stat_print(env, flags=0)
3337 BerkeleyDB::Env env
3338 u_int32_t flags
3339 INIT:
3340 ckActive_Database(env->active) ;
3341 CODE:
3342 #ifndef AT_LEAST_DB_4_3
3343 softCrash("$env->stat_print needs Berkeley DB 4.3 or better") ;
3344 #else
3345 RETVAL = env->Status = env->Env->stat_print(env->Env, flags);
3346 #endif
3347 OUTPUT:
3348 RETVAL
3349
3350 int
3351 lock_stat_print(env, flags=0)
3352 BerkeleyDB::Env env
3353 u_int32_t flags
3354 INIT:
3355 ckActive_Database(env->active) ;
3356 CODE:
3357 #ifndef AT_LEAST_DB_4_3
3358 softCrash("$env->lock_stat_print needs Berkeley DB 4.3 or better") ;
3359 #else
3360 RETVAL = env->Status = env->Env->lock_stat_print(env->Env, flags);
3361 #endif
3362 OUTPUT:
3363 RETVAL
3364
3365 int
3366 mutex_stat_print(env, flags=0)
3367 BerkeleyDB::Env env
3368 u_int32_t flags
3369 INIT:
3370 ckActive_Database(env->active) ;
3371 CODE:
3372 #ifndef AT_LEAST_DB_4_4
3373 softCrash("$env->mutex_stat_print needs Berkeley DB 4.4 or better") ;
3374 #else
3375 RETVAL = env->Status = env->Env->mutex_stat_print(env->Env, flags);
3376 #endif
3377 OUTPUT:
3378 RETVAL
3379
3380
3381 int
3382 txn_stat_print(env, flags=0)
3383 BerkeleyDB::Env env
3384 u_int32_t flags
3385 INIT:
3386 ckActive_Database(env->active) ;
3387 CODE:
3388 #ifndef AT_LEAST_DB_4_3
3389 softCrash("$env->mutex_stat_print needs Berkeley DB 4.3 or better") ;
3390 #else
3391 RETVAL = env->Status = env->Env->txn_stat_print(env->Env, flags);
3392 #endif
3393 OUTPUT:
3394 RETVAL
3395
3396 int
3397 failchk(env, flags=0)
3398 BerkeleyDB::Env env
3399 u_int32_t flags
3400 INIT:
3401 ckActive_Database(env->active) ;
3402 CODE:
3403 #if ! defined(AT_LEAST_DB_4_4) || defined(_WIN32)
3404 #ifndef AT_LEAST_DB_4_4
3405 softCrash("$env->failchk needs Berkeley DB 4.4 or better") ;
3406 #endif
3407 #ifdef _WIN32
3408 softCrash("$env->failchk not supported on Windows") ;
3409 #endif
3410 #else
3411 RETVAL = env->Status = env->Env->failchk(env->Env, flags);
3412 #endif
3413 OUTPUT:
3414 RETVAL
3415
3416 int
3417 set_isalive(env)
3418 BerkeleyDB::Env env
3419 INIT:
3420 ckActive_Database(env->active) ;
3421 CODE:
3422 #if ! defined(AT_LEAST_DB_4_4) || defined(_WIN32)
3423 #ifndef AT_LEAST_DB_4_4
3424 softCrash("$env->set_isalive needs Berkeley DB 4.4 or better") ;
3425 #endif
3426 #ifdef _WIN32
3427 softCrash("$env->set_isalive not supported on Windows") ;
3428 #endif
3429 #else
3430 RETVAL = env->Status = env->Env->set_isalive(env->Env, db_isalive_cb);
3431 #endif
3432 OUTPUT:
3433 RETVAL
3434
3435
3436
3437
3438 MODULE = BerkeleyDB::Term PACKAGE = BerkeleyDB::Term
3439
3440 void
3441 close_everything()
3442 PREINIT:
3443 dMY_CXT;
3444
3445 #define safeCroak(string) softCrash(string)
3446 void
3447 safeCroak(string)
3448 char * string
3449 PREINIT:
3450 dMY_CXT;
3451
3452 MODULE = BerkeleyDB::Hash PACKAGE = BerkeleyDB::Hash PREFIX = hash_
3453
3454 BerkeleyDB::Hash::Raw
3455 _db_open_hash(self, ref)
3456 char * self
3457 SV * ref
3458 PREINIT:
3459 dMY_CXT;
3460 CODE:
3461 {
3462 HV * hash ;
3463 SV * sv ;
3464 DB_INFO info ;
3465 BerkeleyDB__Env dbenv = NULL;
3466 SV * ref_dbenv = NULL;
3467 const char * file = NULL ;
3468 const char * subname = NULL ;
3469 int flags = 0 ;
3470 int mode = 0 ;
3471 BerkeleyDB db ;
3472 BerkeleyDB__Txn txn = NULL ;
3473 char * enc_passwd = NULL ;
3474 int enc_flags = 0 ;
3475
3476 Trace(("_db_open_hash start\n")) ;
3477 hash = (HV*) SvRV(ref) ;
3478 SetValue_pv(file, "Filename", char *) ;
3479 SetValue_pv(subname, "Subname", char *) ;
3480 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3481 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3482 ref_dbenv = sv ;
3483 SetValue_iv(flags, "Flags") ;
3484 SetValue_iv(mode, "Mode") ;
3485 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3486 SetValue_iv(enc_flags, "Enc_Flags") ;
3487
3488 Zero(&info, 1, DB_INFO) ;
3489 SetValue_iv(info.db_cachesize, "Cachesize") ;
3490 SetValue_iv(info.db_lorder, "Lorder") ;
3491 SetValue_iv(info.db_pagesize, "Pagesize") ;
3492 SetValue_iv(info.h_ffactor, "Ffactor") ;
3493 SetValue_iv(info.h_nelem, "Nelem") ;
3494 SetValue_iv(info.flags, "Property") ;
3495 ZMALLOC(db, BerkeleyDB_type) ;
3496 if ((sv = readHash(hash, "Hash")) && sv != &PL_sv_undef) {
3497 info.h_hash = hash_cb ;
3498 db->hash = newSVsv(sv) ;
3499 }
3500 /* DB_DUPSORT was introduced in DB 2.5.9 */
3501 if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
3502 #ifdef DB_DUPSORT
3503 info.dup_compare = dup_compare ;
3504 db->dup_compare = newSVsv(sv) ;
3505 info.flags |= DB_DUP|DB_DUPSORT ;
3506 #else
3507 croak("DupCompare needs Berkeley DB 2.5.9 or later") ;
3508 #endif
3509 }
3510 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3511 DB_HASH, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3512 Trace(("_db_open_hash end\n")) ;
3513 }
3514 OUTPUT:
3515 RETVAL
3516
3517
3518 HV *
3519 db_stat(db, flags=0)
3520 int flags
3521 BerkeleyDB::Common db
3522 HV * RETVAL = NULL ;
3523 PREINIT:
3524 dMY_CXT;
3525 INIT:
3526 ckActive_Database(db->active) ;
3527 CODE:
3528 {
3529 #if DB_VERSION_MAJOR == 2
3530 softCrash("$db->db_stat for a Hash needs Berkeley DB 3.x or better") ;
3531 #else
3532 DB_HASH_STAT * stat ;
3533 #ifdef AT_LEAST_DB_4_3
3534 db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3535 #else
3536 #ifdef AT_LEAST_DB_3_3
3537 db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3538 #else
3539 db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3540 #endif
3541 #endif
3542 if (db->Status) {
3543 XSRETURN_UNDEF;
3544 } else {
3545 RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
3546 hv_store_iv(RETVAL, "hash_magic", stat->hash_magic) ;
3547 hv_store_iv(RETVAL, "hash_version", stat->hash_version);
3548 hv_store_iv(RETVAL, "hash_pagesize", stat->hash_pagesize);
3549 #ifdef AT_LEAST_DB_3_1
3550 hv_store_iv(RETVAL, "hash_nkeys", stat->hash_nkeys);
3551 hv_store_iv(RETVAL, "hash_ndata", stat->hash_ndata);
3552 #else
3553 hv_store_iv(RETVAL, "hash_nrecs", stat->hash_nrecs);
3554 #endif
3555 #ifndef AT_LEAST_DB_3_1
3556 hv_store_iv(RETVAL, "hash_nelem", stat->hash_nelem);
3557 #endif
3558 hv_store_iv(RETVAL, "hash_ffactor", stat->hash_ffactor);
3559 hv_store_iv(RETVAL, "hash_buckets", stat->hash_buckets);
3560 hv_store_iv(RETVAL, "hash_free", stat->hash_free);
3561 hv_store_iv(RETVAL, "hash_bfree", stat->hash_bfree);
3562 hv_store_iv(RETVAL, "hash_bigpages", stat->hash_bigpages);
3563 hv_store_iv(RETVAL, "hash_big_bfree", stat->hash_big_bfree);
3564 hv_store_iv(RETVAL, "hash_overflows", stat->hash_overflows);
3565 hv_store_iv(RETVAL, "hash_ovfl_free", stat->hash_ovfl_free);
3566 hv_store_iv(RETVAL, "hash_dup", stat->hash_dup);
3567 hv_store_iv(RETVAL, "hash_dup_free", stat->hash_dup_free);
3568 #if DB_VERSION_MAJOR >= 3
3569 hv_store_iv(RETVAL, "hash_metaflags", stat->hash_metaflags);
3570 #endif
3571 safefree(stat) ;
3572 }
3573 #endif
3574 }
3575 OUTPUT:
3576 RETVAL
3577
3578
3579 MODULE = BerkeleyDB::Unknown PACKAGE = BerkeleyDB::Unknown PREFIX = hash_
3580
3581 void
3582 _db_open_unknown(ref)
3583 SV * ref
3584 PREINIT:
3585 dMY_CXT;
3586 PPCODE:
3587 {
3588 HV * hash ;
3589 SV * sv ;
3590 DB_INFO info ;
3591 BerkeleyDB__Env dbenv = NULL;
3592 SV * ref_dbenv = NULL;
3593 const char * file = NULL ;
3594 const char * subname = NULL ;
3595 int flags = 0 ;
3596 int mode = 0 ;
3597 BerkeleyDB db ;
3598 BerkeleyDB RETVAL ;
3599 BerkeleyDB__Txn txn = NULL ;
3600 #ifdef AT_LEAST_DB_5_2
3601 static char * Names[] = {"", "Btree", "Hash", "Recno", "Queue", "Unknown", "Heap"} ;
3602 #else
3603 static char * Names[] = {"", "Btree", "Hash", "Recno", "Queue", "Unknown", "Heap"} ;
3604 #endif
3605 char * enc_passwd = NULL ;
3606 int enc_flags = 0 ;
3607
3608 hash = (HV*) SvRV(ref) ;
3609 SetValue_pv(file, "Filename", char *) ;
3610 SetValue_pv(subname, "Subname", char *) ;
3611 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3612 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3613 ref_dbenv = sv ;
3614 SetValue_iv(flags, "Flags") ;
3615 SetValue_iv(mode, "Mode") ;
3616 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3617 SetValue_iv(enc_flags, "Enc_Flags") ;
3618
3619 Zero(&info, 1, DB_INFO) ;
3620 SetValue_iv(info.db_cachesize, "Cachesize") ;
3621 SetValue_iv(info.db_lorder, "Lorder") ;
3622 SetValue_iv(info.db_pagesize, "Pagesize") ;
3623 SetValue_iv(info.h_ffactor, "Ffactor") ;
3624 SetValue_iv(info.h_nelem, "Nelem") ;
3625 SetValue_iv(info.flags, "Property") ;
3626 ZMALLOC(db, BerkeleyDB_type) ;
3627
3628 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3629 DB_UNKNOWN, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3630 XPUSHs(sv_2mortal(newSViv(PTR2IV(RETVAL))));
3631 if (RETVAL)
3632 XPUSHs(sv_2mortal(newSVpv(Names[RETVAL->type], 0))) ;
3633 else
3634 XPUSHs(sv_2mortal(newSViv((IV)NULL)));
3635 }
3636
3637
3638
3639 MODULE = BerkeleyDB::Btree PACKAGE = BerkeleyDB::Btree PREFIX = btree_
3640
3641 BerkeleyDB::Btree::Raw
3642 _db_open_btree(self, ref)
3643 char * self
3644 SV * ref
3645 PREINIT:
3646 dMY_CXT;
3647 CODE:
3648 {
3649 HV * hash ;
3650 SV * sv ;
3651 DB_INFO info ;
3652 BerkeleyDB__Env dbenv = NULL;
3653 SV * ref_dbenv = NULL;
3654 const char * file = NULL ;
3655 const char * subname = NULL ;
3656 int flags = 0 ;
3657 int mode = 0 ;
3658 BerkeleyDB db ;
3659 BerkeleyDB__Txn txn = NULL ;
3660 char * enc_passwd = NULL ;
3661 int enc_flags = 0 ;
3662
3663 Trace(("In _db_open_btree\n"));
3664 hash = (HV*) SvRV(ref) ;
3665 SetValue_pv(file, "Filename", char*) ;
3666 SetValue_pv(subname, "Subname", char *) ;
3667 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3668 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3669 ref_dbenv = sv ;
3670 SetValue_iv(flags, "Flags") ;
3671 SetValue_iv(mode, "Mode") ;
3672 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3673 SetValue_iv(enc_flags, "Enc_Flags") ;
3674
3675 Zero(&info, 1, DB_INFO) ;
3676 SetValue_iv(info.db_cachesize, "Cachesize") ;
3677 SetValue_iv(info.db_lorder, "Lorder") ;
3678 SetValue_iv(info.db_pagesize, "Pagesize") ;
3679 SetValue_iv(info.bt_minkey, "Minkey") ;
3680 SetValue_iv(info.flags, "Property") ;
3681 ZMALLOC(db, BerkeleyDB_type) ;
3682 if ((sv = readHash(hash, "Compare")) && sv != &PL_sv_undef) {
3683 Trace((" Parsed Compare callback\n"));
3684 info.bt_compare = btree_compare ;
3685 db->compare = newSVsv(sv) ;
3686 }
3687 /* DB_DUPSORT was introduced in DB 2.5.9 */
3688 if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) {
3689 #ifdef DB_DUPSORT
3690 Trace((" Parsed DupCompare callback\n"));
3691 info.dup_compare = dup_compare ;
3692 db->dup_compare = newSVsv(sv) ;
3693 info.flags |= DB_DUP|DB_DUPSORT ;
3694 #else
3695 softCrash("DupCompare needs Berkeley DB 2.5.9 or later") ;
3696 #endif
3697 }
3698 if ((sv = readHash(hash, "Prefix")) && sv != &PL_sv_undef) {
3699 Trace((" Parsed Prefix callback\n"));
3700 info.bt_prefix = btree_prefix ;
3701 db->prefix = newSVsv(sv) ;
3702 }
3703
3704 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3705 DB_BTREE, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3706 }
3707 OUTPUT:
3708 RETVAL
3709
3710
3711 HV *
3712 db_stat(db, flags=0)
3713 int flags
3714 BerkeleyDB::Common db
3715 HV * RETVAL = NULL ;
3716 PREINIT:
3717 dMY_CXT;
3718 INIT:
3719 ckActive_Database(db->active) ;
3720 CODE:
3721 {
3722 DB_BTREE_STAT * stat ;
3723 #ifdef AT_LEAST_DB_4_3
3724 db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3725 #else
3726 #ifdef AT_LEAST_DB_3_3
3727 db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3728 #else
3729 db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3730 #endif
3731 #endif
3732 if (db->Status) {
3733 XSRETURN_UNDEF;
3734 } else {
3735 RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
3736 hv_store_iv(RETVAL, "bt_magic", stat->bt_magic);
3737 hv_store_iv(RETVAL, "bt_version", stat->bt_version);
3738 #if DB_VERSION_MAJOR > 2
3739 hv_store_iv(RETVAL, "bt_metaflags", stat->bt_metaflags) ;
3740 hv_store_iv(RETVAL, "bt_flags", stat->bt_metaflags) ;
3741 #else
3742 hv_store_iv(RETVAL, "bt_flags", stat->bt_flags) ;
3743 #endif
3744 #ifndef AT_LEAST_DB_4_4
3745 hv_store_iv(RETVAL, "bt_maxkey", stat->bt_maxkey) ;
3746 #endif
3747 hv_store_iv(RETVAL, "bt_minkey", stat->bt_minkey);
3748 hv_store_iv(RETVAL, "bt_re_len", stat->bt_re_len);
3749 hv_store_iv(RETVAL, "bt_re_pad", stat->bt_re_pad);
3750 hv_store_iv(RETVAL, "bt_pagesize", stat->bt_pagesize);
3751 hv_store_iv(RETVAL, "bt_levels", stat->bt_levels);
3752 #ifdef AT_LEAST_DB_3_1
3753 hv_store_iv(RETVAL, "bt_nkeys", stat->bt_nkeys);
3754 hv_store_iv(RETVAL, "bt_ndata", stat->bt_ndata);
3755 #else
3756 hv_store_iv(RETVAL, "bt_nrecs", stat->bt_nrecs);
3757 #endif
3758 hv_store_iv(RETVAL, "bt_int_pg", stat->bt_int_pg);
3759 hv_store_iv(RETVAL, "bt_leaf_pg", stat->bt_leaf_pg);
3760 hv_store_iv(RETVAL, "bt_dup_pg", stat->bt_dup_pg);
3761 hv_store_iv(RETVAL, "bt_over_pg", stat->bt_over_pg);
3762 hv_store_iv(RETVAL, "bt_free", stat->bt_free);
3763 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
3764 hv_store_iv(RETVAL, "bt_freed", stat->bt_freed);
3765 hv_store_iv(RETVAL, "bt_pfxsaved", stat->bt_pfxsaved);
3766 hv_store_iv(RETVAL, "bt_split", stat->bt_split);
3767 hv_store_iv(RETVAL, "bt_rootsplit", stat->bt_rootsplit);
3768 hv_store_iv(RETVAL, "bt_fastsplit", stat->bt_fastsplit);
3769 hv_store_iv(RETVAL, "bt_added", stat->bt_added);
3770 hv_store_iv(RETVAL, "bt_deleted", stat->bt_deleted);
3771 hv_store_iv(RETVAL, "bt_get", stat->bt_get);
3772 hv_store_iv(RETVAL, "bt_cache_hit", stat->bt_cache_hit);
3773 hv_store_iv(RETVAL, "bt_cache_miss", stat->bt_cache_miss);
3774 #endif
3775 hv_store_iv(RETVAL, "bt_int_pgfree", stat->bt_int_pgfree);
3776 hv_store_iv(RETVAL, "bt_leaf_pgfree", stat->bt_leaf_pgfree);
3777 hv_store_iv(RETVAL, "bt_dup_pgfree", stat->bt_dup_pgfree);
3778 hv_store_iv(RETVAL, "bt_over_pgfree", stat->bt_over_pgfree);
3779 safefree(stat) ;
3780 }
3781 }
3782 OUTPUT:
3783 RETVAL
3784
3785 MODULE = BerkeleyDB::Heap PACKAGE = BerkeleyDB::Heap PREFIX = heap_
3786
3787 BerkeleyDB::Heap::Raw
3788 _db_open_heap(self, ref)
3789 char * self
3790 SV * ref
3791 PREINIT:
3792 dMY_CXT;
3793 CODE:
3794 {
3795 #ifndef AT_LEAST_DB_5_2
3796 softCrash("BerkeleyDB::Heap needs Berkeley DB 5.2.x or better");
3797 #else
3798 HV * hash ;
3799 SV * sv ;
3800 DB_INFO info ;
3801 BerkeleyDB__Env dbenv = NULL;
3802 SV * ref_dbenv = NULL;
3803 const char * file = NULL ;
3804 const char * subname = NULL ;
3805 int flags = 0 ;
3806 int mode = 0 ;
3807 BerkeleyDB db ;
3808 BerkeleyDB__Txn txn = NULL ;
3809 char * enc_passwd = NULL ;
3810 int enc_flags = 0 ;
3811
3812 Trace(("In _db_open_btree\n"));
3813 hash = (HV*) SvRV(ref) ;
3814 SetValue_pv(file, "Filename", char*) ;
3815 SetValue_pv(subname, "Subname", char *) ;
3816 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3817 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3818 ref_dbenv = sv ;
3819 SetValue_iv(flags, "Flags") ;
3820 SetValue_iv(mode, "Mode") ;
3821 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3822 SetValue_iv(enc_flags, "Enc_Flags") ;
3823
3824 Zero(&info, 1, DB_INFO) ;
3825 SetValue_iv(info.db_cachesize, "Cachesize") ;
3826 SetValue_iv(info.db_lorder, "Lorder") ;
3827 SetValue_iv(info.db_pagesize, "Pagesize") ;
3828 SetValue_iv(info.flags, "Property") ;
3829 SetValue_iv(info.heapsize_bytes, "HeapSize") ;
3830 SetValue_iv(info.heapsize_gbytes, "HeapSizeGb") ;
3831 ZMALLOC(db, BerkeleyDB_type) ;
3832 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3833 DB_HEAP, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3834 #endif
3835 }
3836 OUTPUT:
3837 RETVAL
3838
3839
3840
3841 MODULE = BerkeleyDB::Recno PACKAGE = BerkeleyDB::Recno PREFIX = recno_
3842
3843 BerkeleyDB::Recno::Raw
3844 _db_open_recno(self, ref)
3845 char * self
3846 SV * ref
3847 PREINIT:
3848 dMY_CXT;
3849 CODE:
3850 {
3851 HV * hash ;
3852 SV * sv ;
3853 DB_INFO info ;
3854 BerkeleyDB__Env dbenv = NULL;
3855 SV * ref_dbenv = NULL;
3856 const char * file = NULL ;
3857 const char * subname = NULL ;
3858 int flags = 0 ;
3859 int mode = 0 ;
3860 BerkeleyDB db ;
3861 BerkeleyDB__Txn txn = NULL ;
3862 char * enc_passwd = NULL ;
3863 int enc_flags = 0 ;
3864
3865 hash = (HV*) SvRV(ref) ;
3866 SetValue_pv(file, "Fname", char*) ;
3867 SetValue_pv(subname, "Subname", char *) ;
3868 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3869 ref_dbenv = sv ;
3870 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3871 SetValue_iv(flags, "Flags") ;
3872 SetValue_iv(mode, "Mode") ;
3873 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3874 SetValue_iv(enc_flags, "Enc_Flags") ;
3875
3876 Zero(&info, 1, DB_INFO) ;
3877 SetValue_iv(info.db_cachesize, "Cachesize") ;
3878 SetValue_iv(info.db_lorder, "Lorder") ;
3879 SetValue_iv(info.db_pagesize, "Pagesize") ;
3880 SetValue_iv(info.bt_minkey, "Minkey") ;
3881
3882 SetValue_iv(info.flags, "Property") ;
3883 SetValue_pv(info.re_source, "Source", char*) ;
3884 if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
3885 info.re_len = SvIV(sv) ; ;
3886 flagSet_DB2(info.flags, DB_FIXEDLEN) ;
3887 }
3888 if ((sv = readHash(hash, "Delim")) && sv != &PL_sv_undef) {
3889 info.re_delim = SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3890 flagSet_DB2(info.flags, DB_DELIMITER) ;
3891 }
3892 if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
3893 info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3894 flagSet_DB2(info.flags, DB_PAD) ;
3895 }
3896 ZMALLOC(db, BerkeleyDB_type) ;
3897 #ifdef ALLOW_RECNO_OFFSET
3898 SetValue_iv(db->array_base, "ArrayBase") ;
3899 db->array_base = (db->array_base == 0 ? 1 : 0) ;
3900 #endif /* ALLOW_RECNO_OFFSET */
3901
3902 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3903 DB_RECNO, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3904 }
3905 OUTPUT:
3906 RETVAL
3907
3908
3909 MODULE = BerkeleyDB::Queue PACKAGE = BerkeleyDB::Queue PREFIX = recno_
3910
3911 BerkeleyDB::Queue::Raw
3912 _db_open_queue(self, ref)
3913 char * self
3914 SV * ref
3915 PREINIT:
3916 dMY_CXT;
3917 CODE:
3918 {
3919 #ifndef AT_LEAST_DB_3
3920 softCrash("BerkeleyDB::Queue needs Berkeley DB 3.0.x or better");
3921 #else
3922 HV * hash ;
3923 SV * sv ;
3924 DB_INFO info ;
3925 BerkeleyDB__Env dbenv = NULL;
3926 SV * ref_dbenv = NULL;
3927 const char * file = NULL ;
3928 const char * subname = NULL ;
3929 int flags = 0 ;
3930 int mode = 0 ;
3931 BerkeleyDB db ;
3932 BerkeleyDB__Txn txn = NULL ;
3933 char * enc_passwd = NULL ;
3934 int enc_flags = 0 ;
3935
3936 hash = (HV*) SvRV(ref) ;
3937 SetValue_pv(file, "Fname", char*) ;
3938 SetValue_pv(subname, "Subname", char *) ;
3939 SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ;
3940 ref_dbenv = sv ;
3941 SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ;
3942 SetValue_iv(flags, "Flags") ;
3943 SetValue_iv(mode, "Mode") ;
3944 SetValue_pv(enc_passwd,"Enc_Passwd", char *) ;
3945 SetValue_iv(enc_flags, "Enc_Flags") ;
3946
3947 Zero(&info, 1, DB_INFO) ;
3948 SetValue_iv(info.db_cachesize, "Cachesize") ;
3949 SetValue_iv(info.db_lorder, "Lorder") ;
3950 SetValue_iv(info.db_pagesize, "Pagesize") ;
3951 SetValue_iv(info.bt_minkey, "Minkey") ;
3952 SetValue_iv(info.q_extentsize, "ExtentSize") ;
3953
3954
3955 SetValue_iv(info.flags, "Property") ;
3956 if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) {
3957 info.re_len = SvIV(sv) ; ;
3958 flagSet_DB2(info.flags, DB_FIXEDLEN) ;
3959 }
3960 if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) {
3961 info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ;
3962 flagSet_DB2(info.flags, DB_PAD) ;
3963 }
3964 ZMALLOC(db, BerkeleyDB_type) ;
3965 #ifdef ALLOW_RECNO_OFFSET
3966 SetValue_iv(db->array_base, "ArrayBase") ;
3967 db->array_base = (db->array_base == 0 ? 1 : 0) ;
3968 #endif /* ALLOW_RECNO_OFFSET */
3969
3970 RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname,
3971 DB_QUEUE, flags, mode, &info, enc_passwd, enc_flags, hash) ;
3972 #endif
3973 }
3974 OUTPUT:
3975 RETVAL
3976
3977 HV *
3978 db_stat(db, flags=0)
3979 int flags
3980 BerkeleyDB::Common db
3981 HV * RETVAL = NULL ;
3982 PREINIT:
3983 dMY_CXT;
3984 INIT:
3985 ckActive_Database(db->active) ;
3986 CODE:
3987 {
3988 #if DB_VERSION_MAJOR == 2
3989 softCrash("$db->db_stat for a Queue needs Berkeley DB 3.x or better") ;
3990 #else /* Berkeley DB 3, or better */
3991 DB_QUEUE_STAT * stat ;
3992 #ifdef AT_LEAST_DB_4_3
3993 db->Status = ((db->dbp)->stat)(db->dbp, db->txn, &stat, flags) ;
3994 #else
3995 #ifdef AT_LEAST_DB_3_3
3996 db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ;
3997 #else
3998 db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ;
3999 #endif
4000 #endif
4001 if (db->Status) {
4002 XSRETURN_UNDEF;
4003 } else {
4004 RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
4005 hv_store_iv(RETVAL, "qs_magic", stat->qs_magic) ;
4006 hv_store_iv(RETVAL, "qs_version", stat->qs_version);
4007 #ifdef AT_LEAST_DB_3_1
4008 hv_store_iv(RETVAL, "qs_nkeys", stat->qs_nkeys);
4009 hv_store_iv(RETVAL, "qs_ndata", stat->qs_ndata);
4010 #else
4011 hv_store_iv(RETVAL, "qs_nrecs", stat->qs_nrecs);
4012 #endif
4013 hv_store_iv(RETVAL, "qs_pages", stat->qs_pages);
4014 hv_store_iv(RETVAL, "qs_pagesize", stat->qs_pagesize);
4015 hv_store_iv(RETVAL, "qs_pgfree", stat->qs_pgfree);
4016 hv_store_iv(RETVAL, "qs_re_len", stat->qs_re_len);
4017 hv_store_iv(RETVAL, "qs_re_pad", stat->qs_re_pad);
4018 #ifdef AT_LEAST_DB_3_2
4019 #else
4020 hv_store_iv(RETVAL, "qs_start", stat->qs_start);
4021 #endif
4022 hv_store_iv(RETVAL, "qs_first_recno", stat->qs_first_recno);
4023 hv_store_iv(RETVAL, "qs_cur_recno", stat->qs_cur_recno);
4024 #if DB_VERSION_MAJOR >= 3
4025 hv_store_iv(RETVAL, "qs_metaflags", stat->qs_metaflags);
4026 #endif
4027 safefree(stat) ;
4028 }
4029 #endif
4030 }
4031 OUTPUT:
4032 RETVAL
4033
4034 MODULE = BerkeleyDB::Common PACKAGE = BerkeleyDB::Common PREFIX = dab_
4035
4036
4037 DualType
4038 db_close(db,flags=0)
4039 int flags
4040 BerkeleyDB::Common db
4041 PREINIT:
4042 dMY_CXT;
4043 INIT:
4044 ckActive_Database(db->active) ;
4045 saveCurrentDB(db) ;
4046 CODE:
4047 Trace(("BerkeleyDB::Common::db_close %d\n", db));
4048 #ifdef STRICT_CLOSE
4049 if (db->txn)
4050 softCrash("attempted to close a database while a transaction was still open") ;
4051 if (db->open_cursors)
4052 softCrash("attempted to close a database with %d open cursor(s)",
4053 db->open_cursors) ;
4054 #ifdef AT_LEAST_DB_4_3
4055 if (db->open_sequences)
4056 softCrash("attempted to close a database with %d open sequence(s)",
4057 db->open_sequences) ;
4058 #endif /* AT_LEAST_DB_4_3 */
4059 #endif /* STRICT_CLOSE */
4060 RETVAL = db->Status = ((db->dbp)->close)(db->dbp, flags) ;
4061 if (db->parent_env && db->parent_env->open_dbs)
4062 -- db->parent_env->open_dbs ;
4063 db->active = FALSE ;
4064 hash_delete("BerkeleyDB::Term::Db", (char *)db) ;
4065 -- db->open_cursors ;
4066 Trace(("end of BerkeleyDB::Common::db_close\n"));
4067 OUTPUT:
4068 RETVAL
4069
4070 void
4071 dab__DESTROY(db)
4072 BerkeleyDB::Common db
4073 PREINIT:
4074 dMY_CXT;
4075 CODE:
4076 saveCurrentDB(db) ;
4077 Trace(("In BerkeleyDB::Common::_DESTROY db %d dirty=%d\n", db, PL_dirty)) ;
4078 destroyDB(db) ;
4079 Trace(("End of BerkeleyDB::Common::DESTROY \n")) ;
4080
4081 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
4082 #define db_cursor(db, txn, cur,flags) ((db->dbp)->cursor)(db->dbp, txn, cur)
4083 #else
4084 #define db_cursor(db, txn, cur,flags) ((db->dbp)->cursor)(db->dbp, txn, cur,flags)
4085 #endif
4086 BerkeleyDB::Cursor::Raw
4087 _db_cursor(db, flags=0)
4088 u_int32_t flags
4089 BerkeleyDB::Common db
4090 BerkeleyDB::Cursor RETVAL = NULL ;
4091 PREINIT:
4092 dMY_CXT;
4093 ALIAS: __db_write_cursor = 1
4094 INIT:
4095 ckActive_Database(db->active) ;
4096 CODE:
4097 {
4098 DBC * cursor ;
4099 saveCurrentDB(db) ;
4100 if (ix == 1 && db->cds_enabled) {
4101 #ifdef AT_LEAST_DB_3
4102 flags |= DB_WRITECURSOR;
4103 #else
4104 flags |= DB_RMW;
4105 #endif
4106 }
4107 if ((db->Status = db_cursor(db, db->txn, &cursor, flags)) == 0){
4108 ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
4109 db->open_cursors ++ ;
4110 RETVAL->parent_db = db ;
4111 RETVAL->cursor = cursor ;
4112 RETVAL->dbp = db->dbp ;
4113 RETVAL->txn = db->txn ;
4114 RETVAL->type = db->type ;
4115 RETVAL->recno_or_queue = db->recno_or_queue ;
4116 RETVAL->cds_enabled = db->cds_enabled ;
4117 RETVAL->filename = my_strdup(db->filename) ;
4118 RETVAL->compare = db->compare ;
4119 RETVAL->dup_compare = db->dup_compare ;
4120 #ifdef AT_LEAST_DB_3_3
4121 RETVAL->associated = db->associated ;
4122 RETVAL->secondary_db = db->secondary_db;
4123 RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
4124 #endif
4125 #ifdef AT_LEAST_DB_4_8
4126 RETVAL->associated_foreign = db->associated_foreign ;
4127 #endif
4128 RETVAL->prefix = db->prefix ;
4129 RETVAL->hash = db->hash ;
4130 RETVAL->partial = db->partial ;
4131 RETVAL->doff = db->doff ;
4132 RETVAL->dlen = db->dlen ;
4133 RETVAL->active = TRUE ;
4134 #ifdef ALLOW_RECNO_OFFSET
4135 RETVAL->array_base = db->array_base ;
4136 #endif /* ALLOW_RECNO_OFFSET */
4137 #ifdef DBM_FILTERING
4138 RETVAL->filtering = FALSE ;
4139 RETVAL->filter_fetch_key = db->filter_fetch_key ;
4140 RETVAL->filter_store_key = db->filter_store_key ;
4141 RETVAL->filter_fetch_value = db->filter_fetch_value ;
4142 RETVAL->filter_store_value = db->filter_store_value ;
4143 #endif
4144 /* RETVAL->info ; */
4145 hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
4146 }
4147 }
4148 OUTPUT:
4149 RETVAL
4150
4151 BerkeleyDB::Cursor::Raw
4152 _db_join(db, cursors, flags=0)
4153 u_int32_t flags
4154 BerkeleyDB::Common db
4155 AV * cursors
4156 BerkeleyDB::Cursor RETVAL = NULL ;
4157 PREINIT:
4158 dMY_CXT;
4159 INIT:
4160 ckActive_Database(db->active) ;
4161 CODE:
4162 {
4163 #if DB_VERSION_MAJOR == 2 && (DB_VERSION_MINOR < 5 || (DB_VERSION_MINOR == 5 && DB_VERSION_PATCH < 2))
4164 softCrash("join needs Berkeley DB 2.5.2 or later") ;
4165 #else /* Berkeley DB >= 2.5.2 */
4166 DBC * join_cursor ;
4167 DBC ** cursor_list ;
4168 I32 count = av_len(cursors) + 1 ;
4169 int i ;
4170 saveCurrentDB(db) ;
4171 if (count < 1 )
4172 softCrash("db_join: No cursors in parameter list") ;
4173 cursor_list = (DBC **)safemalloc(sizeof(DBC*) * (count + 1));
4174 for (i = 0 ; i < count ; ++i) {
4175 SV * obj = (SV*) * av_fetch(cursors, i, FALSE) ;
4176 IV tmp = SvIV(getInnerObject(obj)) ;
4177 BerkeleyDB__Cursor cur = INT2PTR(BerkeleyDB__Cursor, tmp);
4178 if (cur->dbp == db->dbp)
4179 softCrash("attempted to do a self-join");
4180 cursor_list[i] = cur->cursor ;
4181 }
4182 cursor_list[i] = NULL ;
4183 #if DB_VERSION_MAJOR == 2
4184 if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, flags, &join_cursor)) == 0){
4185 #else
4186 if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, &join_cursor, flags)) == 0){
4187 #endif
4188 ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
4189 db->open_cursors ++ ;
4190 RETVAL->parent_db = db ;
4191 RETVAL->cursor = join_cursor ;
4192 RETVAL->dbp = db->dbp ;
4193 RETVAL->type = db->type ;
4194 RETVAL->filename = my_strdup(db->filename) ;
4195 RETVAL->compare = db->compare ;
4196 RETVAL->dup_compare = db->dup_compare ;
4197 #ifdef AT_LEAST_DB_3_3
4198 RETVAL->associated = db->associated ;
4199 RETVAL->secondary_db = db->secondary_db;
4200 RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
4201 #endif
4202 #ifdef AT_LEAST_DB_4_8
4203 RETVAL->associated_foreign = db->associated_foreign ;
4204 #endif
4205 RETVAL->prefix = db->prefix ;
4206 RETVAL->hash = db->hash ;
4207 RETVAL->partial = db->partial ;
4208 RETVAL->doff = db->doff ;
4209 RETVAL->dlen = db->dlen ;
4210 RETVAL->active = TRUE ;
4211 #ifdef ALLOW_RECNO_OFFSET
4212 RETVAL->array_base = db->array_base ;
4213 #endif /* ALLOW_RECNO_OFFSET */
4214 #ifdef DBM_FILTERING
4215 RETVAL->filtering = FALSE ;
4216 RETVAL->filter_fetch_key = db->filter_fetch_key ;
4217 RETVAL->filter_store_key = db->filter_store_key ;
4218 RETVAL->filter_fetch_value = db->filter_fetch_value ;
4219 RETVAL->filter_store_value = db->filter_store_value ;
4220 #endif
4221 /* RETVAL->info ; */
4222 hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
4223 }
4224 safefree(cursor_list) ;
4225 #endif /* Berkeley DB >= 2.5.2 */
4226 }
4227 OUTPUT:
4228 RETVAL
4229
4230 int
4231 ArrayOffset(db)
4232 BerkeleyDB::Common db
4233 PREINIT:
4234 dMY_CXT;
4235 INIT:
4236 ckActive_Database(db->active) ;
4237 CODE:
4238 #ifdef ALLOW_RECNO_OFFSET
4239 RETVAL = db->array_base ? 0 : 1 ;
4240 #else
4241 RETVAL = 0 ;
4242 #endif /* ALLOW_RECNO_OFFSET */
4243 OUTPUT:
4244 RETVAL
4245
4246
4247 bool
4248 cds_enabled(db)
4249 BerkeleyDB::Common db
4250 PREINIT:
4251 dMY_CXT;
4252 INIT:
4253 ckActive_Database(db->active) ;
4254 CODE:
4255 RETVAL = db->cds_enabled ;
4256 OUTPUT:
4257 RETVAL
4258
4259
4260 int
4261 stat_print(db, flags=0)
4262 BerkeleyDB::Common db
4263 u_int32_t flags
4264 INIT:
4265 ckActive_Database(db->active) ;
4266 CODE:
4267 #ifndef AT_LEAST_DB_4_3
4268 softCrash("$db->stat_print needs Berkeley DB 4.3 or better") ;
4269 #else
4270 RETVAL = db->dbp->stat_print(db->dbp, flags);
4271 #endif
4272 OUTPUT:
4273 RETVAL
4274
4275
4276 int
4277 type(db)
4278 BerkeleyDB::Common db
4279 PREINIT:
4280 dMY_CXT;
4281 INIT:
4282 ckActive_Database(db->active) ;
4283 CODE:
4284 RETVAL = db->type ;
4285 OUTPUT:
4286 RETVAL
4287
4288 int
4289 byteswapped(db)
4290 BerkeleyDB::Common db
4291 PREINIT:
4292 dMY_CXT;
4293 INIT:
4294 ckActive_Database(db->active) ;
4295 CODE:
4296 #if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
4297 softCrash("byteswapped needs Berkeley DB 2.5 or later") ;
4298 #else
4299 #if DB_VERSION_MAJOR == 2
4300 RETVAL = db->dbp->byteswapped ;
4301 #else
4302 #ifdef AT_LEAST_DB_3_3
4303 db->dbp->get_byteswapped(db->dbp, &RETVAL) ;
4304 #else
4305 RETVAL = db->dbp->get_byteswapped(db->dbp) ;
4306 #endif
4307 #endif
4308 #endif
4309 OUTPUT:
4310 RETVAL
4311
4312 DualType
4313 status(db)
4314 BerkeleyDB::Common db
4315 PREINIT:
4316 dMY_CXT;
4317 CODE:
4318 RETVAL = db->Status ;
4319 OUTPUT:
4320 RETVAL
4321
4322 #ifdef DBM_FILTERING
4323
4324 #define setFilter(ftype) \
4325 { \
4326 if (db->ftype) \
4327 RETVAL = sv_mortalcopy(db->ftype) ; \
4328 ST(0) = RETVAL ; \
4329 if (db->ftype && (code == &PL_sv_undef)) { \
4330 SvREFCNT_dec(db->ftype) ; \
4331 db->ftype = NULL ; \
4332 } \
4333 else if (code) { \
4334 if (db->ftype) \
4335 sv_setsv(db->ftype, code) ; \
4336 else \
4337 db->ftype = newSVsv(code) ; \
4338 } \
4339 }
4340
4341
4342 SV *
4343 filter_fetch_key(db, code)
4344 BerkeleyDB::Common db
4345 SV * code
4346 SV * RETVAL = &PL_sv_undef ;
4347 CODE:
4348 DBM_setFilter(db->filter_fetch_key, code) ;
4349
4350 SV *
4351 filter_store_key(db, code)
4352 BerkeleyDB::Common db
4353 SV * code
4354 SV * RETVAL = &PL_sv_undef ;
4355 CODE:
4356 DBM_setFilter(db->filter_store_key, code) ;
4357
4358 SV *
4359 filter_fetch_value(db, code)
4360 BerkeleyDB::Common db
4361 SV * code
4362 SV * RETVAL = &PL_sv_undef ;
4363 CODE:
4364 DBM_setFilter(db->filter_fetch_value, code) ;
4365
4366 SV *
4367 filter_store_value(db, code)
4368 BerkeleyDB::Common db
4369 SV * code
4370 SV * RETVAL = &PL_sv_undef ;
4371 CODE:
4372 DBM_setFilter(db->filter_store_value, code) ;
4373
4374 #endif /* DBM_FILTERING */
4375
4376 void
4377 partial_set(db, offset, length)
4378 BerkeleyDB::Common db
4379 u_int32_t offset
4380 u_int32_t length
4381 PREINIT:
4382 dMY_CXT;
4383 INIT:
4384 ckActive_Database(db->active) ;
4385 PPCODE:
4386 if (GIMME == G_ARRAY) {
4387 XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
4388 XPUSHs(sv_2mortal(newSViv(db->doff))) ;
4389 XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
4390 }
4391 db->partial = DB_DBT_PARTIAL ;
4392 db->doff = offset ;
4393 db->dlen = length ;
4394
4395
4396 void
4397 partial_clear(db)
4398 BerkeleyDB::Common db
4399 PREINIT:
4400 dMY_CXT;
4401 INIT:
4402 ckActive_Database(db->active) ;
4403 PPCODE:
4404 if (GIMME == G_ARRAY) {
4405 XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ;
4406 XPUSHs(sv_2mortal(newSViv(db->doff))) ;
4407 XPUSHs(sv_2mortal(newSViv(db->dlen))) ;
4408 }
4409 db->partial =
4410 db->doff =
4411 db->dlen = 0 ;
4412
4413
4414 #define db_del(db, key, flags) \
4415 (db->Status = ((db->dbp)->del)(db->dbp, db->txn, &key, flags))
4416 DualType
4417 db_del(db, key, flags=0)
4418 u_int flags
4419 BerkeleyDB::Common db
4420 DBTKEY key
4421 PREINIT:
4422 dMY_CXT;
4423 INIT:
4424 Trace(("db_del db[%p] in [%p] txn[%p] key[%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
4425 ckActive_Database(db->active) ;
4426 saveCurrentDB(db) ;
4427
4428
4429 #ifdef AT_LEAST_DB_3
4430 # ifdef AT_LEAST_DB_3_2
4431 # define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_CONSUME_WAIT)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4432 # else
4433 # define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4434 # endif
4435 #else
4436 #define writeToKey() (flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO))
4437 #endif
4438 #define db_get(db, key, data, flags) \
4439 (db->Status = ((db->dbp)->get)(db->dbp, db->txn, &key, &data, flags))
4440 DualType
4441 db_get(db, key, data, flags=0)
4442 u_int flags
4443 BerkeleyDB::Common db
4444 DBTKEY_B key
4445 DBT_OPT data
4446 PREINIT:
4447 dMY_CXT;
4448 CODE:
4449 ckActive_Database(db->active) ;
4450 saveCurrentDB(db) ;
4451 SetPartial(data,db) ;
4452 Trace(("db_get db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
4453 RETVAL = db_get(db, key, data, flags);
4454 Trace((" RETVAL %d\n", RETVAL));
4455 OUTPUT:
4456 RETVAL
4457 key if (writeToKey()) OutputKey(ST(1), key) ;
4458 data
4459
4460 #define db_exists(db, key, flags) \
4461 (db->Status = ((db->dbp)->exists)(db->dbp, db->txn, &key, flags))
4462 DualType
4463 db_exists(db, key, flags=0)
4464 u_int flags
4465 BerkeleyDB::Common db
4466 DBTKEY_B key
4467 PREINIT:
4468 dMY_CXT;
4469 CODE:
4470 #ifndef AT_LEAST_DB_4_6
4471 softCrash("db_exists needs at least Berkeley DB 4.6");
4472 #else
4473 ckActive_Database(db->active) ;
4474 saveCurrentDB(db) ;
4475 Trace(("db_exists db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ;
4476 RETVAL = db_exists(db, key, flags);
4477 Trace((" RETVAL %d\n", RETVAL));
4478 #endif
4479 OUTPUT:
4480 RETVAL
4481
4482
4483 #define db_pget(db, key, pkey, data, flags) \
4484 (db->Status = ((db->dbp)->pget)(db->dbp, db->txn, &key, &pkey, &data, flags))
4485 DualType
4486 db_pget(db, key, pkey, data, flags=0)
4487 u_int flags
4488 BerkeleyDB::Common db
4489 DBTKEY_B key
4490 DBTKEY_Bpr pkey
4491 DBT_OPT data
4492 PREINIT:
4493 dMY_CXT;
4494 CODE:
4495 #ifndef AT_LEAST_DB_3_3
4496 softCrash("db_pget needs at least Berkeley DB 3.3");
4497 #else
4498 Trace(("db_pget db [%p] in [%p] txn [%p] flags [%d]\n", db->dbp, db, db->txn, flags)) ;
4499 ckActive_Database(db->active) ;
4500 saveCurrentDB(db) ;
4501 SetPartial(data,db) ;
4502 RETVAL = db_pget(db, key, pkey, data, flags);
4503 Trace((" RETVAL %d\n", RETVAL));
4504 #endif
4505 OUTPUT:
4506 RETVAL
4507 key if (writeToKey()) OutputKey(ST(1), key) ;
4508 pkey
4509 data
4510
4511 #define db_put(db,key,data,flag) \
4512 (db->Status = (db->dbp->put)(db->dbp,db->txn,&key,&data,flag))
4513 DualType
4514 db_put(db, key, data, flags=0)
4515 u_int flags
4516 BerkeleyDB::Common db
4517 DBTKEY key
4518 DBT data
4519 PREINIT:
4520 dMY_CXT;
4521 CODE:
4522 ckActive_Database(db->active) ;
4523 saveCurrentDB(db) ;
4524 /* SetPartial(data,db) ; */
4525 Trace(("db_put db[%p] in [%p] txn[%p] key[%.*s] data [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, data.size, data.data, flags)) ;
4526 RETVAL = db_put(db, key, data, flags);
4527 Trace((" RETVAL %d\n", RETVAL));
4528 OUTPUT:
4529 RETVAL
4530 key if (flagSet(DB_APPEND)) OutputKey(ST(1), key) ;
4531
4532 #define db_key_range(db, key, range, flags) \
4533 (db->Status = ((db->dbp)->key_range)(db->dbp, db->txn, &key, &range, flags))
4534 DualType
4535 db_key_range(db, key, less, equal, greater, flags=0)
4536 u_int32_t flags
4537 BerkeleyDB::Common db
4538 DBTKEY_B key
4539 double less = 0.0 ;
4540 double equal = 0.0 ;
4541 double greater = 0.0 ;
4542 PREINIT:
4543 dMY_CXT;
4544 CODE:
4545 {
4546 #ifndef AT_LEAST_DB_3_1
4547 softCrash("key_range needs Berkeley DB 3.1.x or later") ;
4548 #else
4549 DB_KEY_RANGE range ;
4550 range.less = range.equal = range.greater = 0.0 ;
4551 ckActive_Database(db->active) ;
4552 saveCurrentDB(db) ;
4553 RETVAL = db_key_range(db, key, range, flags);
4554 if (RETVAL == 0) {
4555 less = range.less ;
4556 equal = range.equal;
4557 greater = range.greater;
4558 }
4559 #endif
4560 }
4561 OUTPUT:
4562 RETVAL
4563 less
4564 equal
4565 greater
4566
4567
4568 #define db_fd(d, x) (db->Status = (db->dbp->fd)(db->dbp, &x))
4569 int
4570 db_fd(db)
4571 BerkeleyDB::Common db
4572 PREINIT:
4573 dMY_CXT;
4574 INIT:
4575 ckActive_Database(db->active) ;
4576 CODE:
4577 saveCurrentDB(db) ;
4578 db_fd(db, RETVAL) ;
4579 OUTPUT:
4580 RETVAL
4581
4582
4583 #define db_sync(db, fl) (db->Status = (db->dbp->sync)(db->dbp, fl))
4584 DualType
4585 db_sync(db, flags=0)
4586 u_int flags
4587 BerkeleyDB::Common db
4588 PREINIT:
4589 dMY_CXT;
4590 INIT:
4591 ckActive_Database(db->active) ;
4592 saveCurrentDB(db) ;
4593
4594 void
4595 _Txn(db, txn=NULL)
4596 BerkeleyDB::Common db
4597 BerkeleyDB::Txn txn
4598 PREINIT:
4599 dMY_CXT;
4600 INIT:
4601 ckActive_Database(db->active) ;
4602 CODE:
4603 if (txn) {
4604 Trace(("_Txn[%p] in[%p] active [%d]\n", txn->txn, txn, txn->active));
4605 ckActive_Transaction(txn->active) ;
4606 db->txn = txn->txn ;
4607 }
4608 else {
4609 Trace(("_Txn[undef] \n"));
4610 db->txn = NULL ;
4611 }
4612
4613
4614 #define db_truncate(db, countp, flags) \
4615 (db->Status = ((db->dbp)->truncate)(db->dbp, db->txn, &countp, flags))
4616 DualType
4617 truncate(db, countp, flags=0)
4618 BerkeleyDB::Common db
4619 u_int32_t countp = NO_INIT
4620 u_int32_t flags
4621 PREINIT:
4622 dMY_CXT;
4623 INIT:
4624 ckActive_Database(db->active) ;
4625 CODE:
4626 #ifndef AT_LEAST_DB_3_3
4627 softCrash("truncate needs Berkeley DB 3.3 or later") ;
4628 #else
4629 saveCurrentDB(db) ;
4630 RETVAL = db_truncate(db, countp, flags);
4631 #endif
4632 OUTPUT:
4633 RETVAL
4634 countp
4635
4636 #ifdef AT_LEAST_DB_4_1
4637 # define db_associate(db, sec, cb, flags)\
4638 (db->Status = ((db->dbp)->associate)(db->dbp, db->txn, sec->dbp, &cb, flags))
4639 #else
4640 # define db_associate(db, sec, cb, flags)\
4641 (db->Status = ((db->dbp)->associate)(db->dbp, sec->dbp, &cb, flags))
4642 #endif
4643 DualType
4644 associate(db, secondary, callback, flags=0)
4645 BerkeleyDB::Common db
4646 BerkeleyDB::Common secondary
4647 SV* callback
4648 u_int32_t flags
4649 PREINIT:
4650 dMY_CXT;
4651 INIT:
4652 ckActive_Database(db->active) ;
4653 CODE:
4654 #ifndef AT_LEAST_DB_3_3
4655 softCrash("associate needs Berkeley DB 3.3 or later") ;
4656 #else
4657 saveCurrentDB(db) ;
4658 /* db->associated = newSVsv(callback) ; */
4659 secondary->associated = newSVsv(callback) ;
4660 secondary->primary_recno_or_queue = db->recno_or_queue ;
4661 /* secondary->dbp->app_private = secondary->associated ; */
4662 secondary->secondary_db = TRUE;
4663 if (secondary->recno_or_queue)
4664 RETVAL = db_associate(db, secondary, associate_cb_recno, flags);
4665 else
4666 RETVAL = db_associate(db, secondary, associate_cb, flags);
4667 #endif
4668 OUTPUT:
4669 RETVAL
4670
4671 #define db_associate_foreign(db, sec, cb, flags)\
4672 (db->Status = ((db->dbp)->associate_foreign)(db->dbp, sec->dbp, cb, flags))
4673 DualType
4674 associate_foreign(db, secondary, callback, flags)
4675 BerkeleyDB::Common db
4676 BerkeleyDB::Common secondary
4677 SV* callback
4678 u_int32_t flags
4679 foreign_cb_type callback_ptr = NULL;
4680 PREINIT:
4681 dMY_CXT;
4682 INIT:
4683 ckActive_Database(db->active) ;
4684 CODE:
4685 #ifndef AT_LEAST_DB_4_8
4686 softCrash("associate_foreign needs Berkeley DB 4.8 or later") ;
4687 #else
4688 saveCurrentDB(db) ;
4689 if (callback != &PL_sv_undef)
4690 {
4691 //softCrash("associate_foreign does not support callbacks yet") ;
4692 secondary->associated_foreign = newSVsv(callback) ;
4693 callback_ptr = ( secondary->recno_or_queue
4694 ? associate_foreign_cb_recno
4695 : associate_foreign_cb);
4696 }
4697 secondary->primary_recno_or_queue = db->recno_or_queue ;
4698 secondary->secondary_db = TRUE;
4699 RETVAL = db_associate_foreign(db, secondary, callback_ptr, flags);
4700 #endif
4701 OUTPUT:
4702 RETVAL
4703
4704 DualType
4705 compact(db, start=NULL, stop=NULL, c_data=NULL, flags=0, end=NULL)
4706 PREINIT:
4707 dMY_CXT;
4708 PREINIT:
4709 DBTKEY end_key;
4710 INPUT:
4711 BerkeleyDB::Common db
4712 SVnull* start
4713 SVnull* stop
4714 SVnull* c_data
4715 u_int32_t flags
4716 SVnull* end
4717 CODE:
4718 {
4719 #ifndef AT_LEAST_DB_4_4
4720 softCrash("compact needs Berkeley DB 4.4 or later") ;
4721 #else
4722 DBTKEY start_key;
4723 DBTKEY stop_key;
4724 DBTKEY* start_p = NULL;
4725 DBTKEY* stop_p = NULL;
4726 DBTKEY* end_p = NULL;
4727 DB_COMPACT cmpt;
4728 DB_COMPACT* cmpt_p = NULL;
4729 SV * sv;
4730 HV* hash = NULL;
4731
4732 DBT_clear(start_key);
4733 DBT_clear(stop_key);
4734 DBT_clear(end_key);
4735 Zero(&cmpt, 1, DB_COMPACT) ;
4736 ckActive_Database(db->active) ;
4737 saveCurrentDB(db) ;
4738 if (start && SvOK(start)) {
4739 start_p = &start_key;
4740 DBM_ckFilter(start, filter_store_key, "filter_store_key");
4741 GetKey(db, start, start_p);
4742 }
4743 if (stop && SvOK(stop)) {
4744 stop_p = &stop_key;
4745 DBM_ckFilter(stop, filter_store_key, "filter_store_key");
4746 GetKey(db, stop, stop_p);
4747 }
4748 if (end) {
4749 end_p = &end_key;
4750 }
4751 if (c_data && SvOK(c_data)) {
4752 hash = (HV*) SvRV(c_data) ;
4753 cmpt_p = & cmpt;
4754 cmpt.compact_fillpercent = GetValue_iv(hash,"compact_fillpercent") ;
4755 cmpt.compact_timeout = (db_timeout_t) GetValue_iv(hash, "compact_timeout");
4756 }
4757 RETVAL = (db->dbp)->compact(db->dbp, db->txn, start_p, stop_p, cmpt_p, flags, end_p);
4758 if (RETVAL == 0 && hash) {
4759 hv_store_iv(hash, "compact_deadlock", cmpt.compact_deadlock) ;
4760 hv_store_iv(hash, "compact_levels", cmpt.compact_levels) ;
4761 hv_store_iv(hash, "compact_pages_free", cmpt.compact_pages_free) ;
4762 hv_store_iv(hash, "compact_pages_examine", cmpt.compact_pages_examine) ;
4763 hv_store_iv(hash, "compact_pages_truncated", cmpt.compact_pages_truncated) ;
4764 }
4765 #endif
4766 }
4767 OUTPUT:
4768 RETVAL
4769 end if (RETVAL == 0 && end) OutputValue_B(ST(5), end_key) ;
4770
4771
4772 MODULE = BerkeleyDB::Cursor PACKAGE = BerkeleyDB::Cursor PREFIX = cu_
4773
4774 BerkeleyDB::Cursor::Raw
4775 _c_dup(db, flags=0)
4776 u_int32_t flags
4777 BerkeleyDB::Cursor db
4778 BerkeleyDB::Cursor RETVAL = NULL ;
4779 PREINIT:
4780 dMY_CXT;
4781 INIT:
4782 saveCurrentDB(db->parent_db);
4783 ckActive_Database(db->active) ;
4784 CODE:
4785 {
4786 #ifndef AT_LEAST_DB_3
4787 softCrash("c_dup needs at least Berkeley DB 3.0.x");
4788 #else
4789 DBC * newcursor ;
4790 db->Status = ((db->cursor)->c_dup)(db->cursor, &newcursor, flags) ;
4791 if (db->Status == 0){
4792 ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ;
4793 db->parent_db->open_cursors ++ ;
4794 RETVAL->parent_db = db->parent_db ;
4795 RETVAL->cursor = newcursor ;
4796 RETVAL->dbp = db->dbp ;
4797 RETVAL->type = db->type ;
4798 RETVAL->recno_or_queue = db->recno_or_queue ;
4799 RETVAL->primary_recno_or_queue = db->primary_recno_or_queue ;
4800 RETVAL->cds_enabled = db->cds_enabled ;
4801 RETVAL->filename = my_strdup(db->filename) ;
4802 RETVAL->compare = db->compare ;
4803 RETVAL->dup_compare = db->dup_compare ;
4804 #ifdef AT_LEAST_DB_3_3
4805 RETVAL->associated = db->associated ;
4806 #endif
4807 #ifdef AT_LEAST_DB_4_8
4808 RETVAL->associated_foreign = db->associated_foreign ;
4809 #endif
4810 RETVAL->prefix = db->prefix ;
4811 RETVAL->hash = db->hash ;
4812 RETVAL->partial = db->partial ;
4813 RETVAL->doff = db->doff ;
4814 RETVAL->dlen = db->dlen ;
4815 RETVAL->active = TRUE ;
4816 #ifdef ALLOW_RECNO_OFFSET
4817 RETVAL->array_base = db->array_base ;
4818 #endif /* ALLOW_RECNO_OFFSET */
4819 #ifdef DBM_FILTERING
4820 RETVAL->filtering = FALSE ;
4821 RETVAL->filter_fetch_key = db->filter_fetch_key ;
4822 RETVAL->filter_store_key = db->filter_store_key ;
4823 RETVAL->filter_fetch_value = db->filter_fetch_value ;
4824 RETVAL->filter_store_value = db->filter_store_value ;
4825 #endif /* DBM_FILTERING */
4826 /* RETVAL->info ; */
4827 hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ;
4828 }
4829 #endif
4830 }
4831 OUTPUT:
4832 RETVAL
4833
4834 DualType
4835 _c_close(db)
4836 BerkeleyDB::Cursor db
4837 PREINIT:
4838 dMY_CXT;
4839 INIT:
4840 saveCurrentDB(db->parent_db);
4841 ckActive_Cursor(db->active) ;
4842 hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
4843 CODE:
4844 RETVAL = db->Status =
4845 ((db->cursor)->c_close)(db->cursor) ;
4846 db->active = FALSE ;
4847 if (db->parent_db->open_cursors)
4848 -- db->parent_db->open_cursors ;
4849 OUTPUT:
4850 RETVAL
4851
4852 void
4853 _DESTROY(db)
4854 BerkeleyDB::Cursor db
4855 PREINIT:
4856 dMY_CXT;
4857 CODE:
4858 saveCurrentDB(db->parent_db);
4859 Trace(("In BerkeleyDB::Cursor::_DESTROY db %d dirty=%d active=%d\n", db, PL_dirty, db->active));
4860 hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ;
4861 if (db->active)
4862 ((db->cursor)->c_close)(db->cursor) ;
4863 if (db->parent_db->open_cursors)
4864 -- db->parent_db->open_cursors ;
4865 Safefree(db->filename) ;
4866 Safefree(db) ;
4867 Trace(("End of BerkeleyDB::Cursor::_DESTROY\n")) ;
4868
4869 DualType
4870 status(db)
4871 BerkeleyDB::Cursor db
4872 PREINIT:
4873 dMY_CXT;
4874 CODE:
4875 RETVAL = db->Status ;
4876 OUTPUT:
4877 RETVAL
4878
4879
4880 #define cu_c_del(c,f) (c->Status = ((c->cursor)->c_del)(c->cursor,f))
4881 DualType
4882 cu_c_del(db, flags=0)
4883 int flags
4884 BerkeleyDB::Cursor db
4885 PREINIT:
4886 dMY_CXT;
4887 INIT:
4888 saveCurrentDB(db->parent_db);
4889 ckActive_Cursor(db->active) ;
4890 OUTPUT:
4891 RETVAL
4892
4893
4894 #define cu_c_get(c,k,d,f) (c->Status = (c->cursor->c_get)(c->cursor,&k,&d,f))
4895 DualType
4896 cu_c_get(db, key, data, flags=0)
4897 int flags
4898 BerkeleyDB::Cursor db
4899 DBTKEY_B key
4900 DBT_B data
4901 PREINIT:
4902 dMY_CXT;
4903 INIT:
4904 Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ;
4905 saveCurrentDB(db->parent_db);
4906 ckActive_Cursor(db->active) ;
4907 /* DBT_clear(key); */
4908 /* DBT_clear(data); */
4909 SetPartial(data,db) ;
4910 Trace(("c_get end\n")) ;
4911 OUTPUT:
4912 RETVAL
4913 key
4914 data if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ;
4915
4916 #define cu_c_pget(c,k,p,d,f) (c->Status = (c->secondary_db ? (c->cursor->c_pget)(c->cursor,&k,&p,&d,f) : EINVAL))
4917 DualType
4918 cu_c_pget(db, key, pkey, data, flags=0)
4919 int flags
4920 BerkeleyDB::Cursor db
4921 DBTKEY_B key
4922 DBTKEY_Bpr pkey
4923 DBT_B data
4924 PREINIT:
4925 dMY_CXT;
4926 CODE:
4927 #ifndef AT_LEAST_DB_3_3
4928 softCrash("db_c_pget needs at least Berkeley DB 3.3");
4929 #else
4930 Trace(("c_pget db [%d] flags [%d]\n", db, flags)) ;
4931 saveCurrentDB(db->parent_db);
4932 ckActive_Cursor(db->active) ;
4933 SetPartial(data,db) ;
4934 RETVAL = cu_c_pget(db, key, pkey, data, flags);
4935 Trace(("c_pget end\n")) ;
4936 #endif
4937 OUTPUT:
4938 RETVAL
4939 key if (writeToKey()) OutputKey(ST(1), key) ;
4940 pkey
4941 data
4942
4943
4944
4945 #define cu_c_put(c,k,d,f) (c->Status = (c->cursor->c_put)(c->cursor,&k,&d,f))
4946 DualType
4947 cu_c_put(db, key, data, flags=0)
4948 int flags
4949 BerkeleyDB::Cursor db
4950 DBTKEY key
4951 DBT data
4952 PREINIT:
4953 dMY_CXT;
4954 INIT:
4955 saveCurrentDB(db->parent_db);
4956 ckActive_Cursor(db->active) ;
4957 /* SetPartial(data,db) ; */
4958 OUTPUT:
4959 RETVAL
4960
4961 #define cu_c_count(c,p,f) (c->Status = (c->cursor->c_count)(c->cursor,&p,f))
4962 DualType
4963 cu_c_count(db, count, flags=0)
4964 int flags
4965 BerkeleyDB::Cursor db
4966 u_int32_t count = NO_INIT
4967 PREINIT:
4968 dMY_CXT;
4969 CODE:
4970 #ifndef AT_LEAST_DB_3_1
4971 softCrash("c_count needs at least Berkeley DB 3.1.x");
4972 #else
4973 Trace(("c_get count [%d] flags [%d]\n", db, flags)) ;
4974 saveCurrentDB(db->parent_db);
4975 ckActive_Cursor(db->active) ;
4976 RETVAL = cu_c_count(db, count, flags) ;
4977 Trace((" c_count got %d duplicates\n", count)) ;
4978 #endif
4979 OUTPUT:
4980 RETVAL
4981 count
4982
4983 MODULE = BerkeleyDB::TxnMgr PACKAGE = BerkeleyDB::TxnMgr PREFIX = xx_
4984
4985 BerkeleyDB::Txn::Raw
4986 _txn_begin(txnmgr, pid=NULL, flags=0)
4987 u_int32_t flags
4988 BerkeleyDB::TxnMgr txnmgr
4989 BerkeleyDB::Txn pid
4990 PREINIT:
4991 dMY_CXT;
4992 CODE:
4993 {
4994 DB_TXN *txn ;
4995 DB_TXN *p_id = NULL ;
4996 #if DB_VERSION_MAJOR == 2
4997 if (txnmgr->env->Env->tx_info == NULL)
4998 softCrash("Transaction Manager not enabled") ;
4999 #endif
5000 if (pid)
5001 p_id = pid->txn ;
5002 txnmgr->env->TxnMgrStatus =
5003 #if DB_VERSION_MAJOR == 2
5004 txn_begin(txnmgr->env->Env->tx_info, p_id, &txn) ;
5005 #else
5006 # ifdef AT_LEAST_DB_4
5007 txnmgr->env->Env->txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
5008 # else
5009 txn_begin(txnmgr->env->Env, p_id, &txn, flags) ;
5010 # endif
5011 #endif
5012 if (txnmgr->env->TxnMgrStatus == 0) {
5013 ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ;
5014 RETVAL->txn = txn ;
5015 RETVAL->active = TRUE ;
5016 Trace(("_txn_begin created txn [%d] in [%d]\n", txn, RETVAL));
5017 hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ;
5018 }
5019 else
5020 RETVAL = NULL ;
5021 }
5022 OUTPUT:
5023 RETVAL
5024
5025
5026 DualType
5027 status(mgr)
5028 BerkeleyDB::TxnMgr mgr
5029 PREINIT:
5030 dMY_CXT;
5031 CODE:
5032 RETVAL = mgr->env->TxnMgrStatus ;
5033 OUTPUT:
5034 RETVAL
5035
5036
5037 void
5038 _DESTROY(mgr)
5039 BerkeleyDB::TxnMgr mgr
5040 PREINIT:
5041 dMY_CXT;
5042 CODE:
5043 Trace(("In BerkeleyDB::TxnMgr::DESTROY dirty=%d\n", PL_dirty)) ;
5044 Safefree(mgr) ;
5045 Trace(("End of BerkeleyDB::TxnMgr::DESTROY\n")) ;
5046
5047 DualType
5048 txn_close(txnp)
5049 BerkeleyDB::TxnMgr txnp
5050 NOT_IMPLEMENTED_YET
5051
5052
5053 #if DB_VERSION_MAJOR == 2
5054 # define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env->tx_info, k, m)
5055 #else
5056 # ifdef AT_LEAST_DB_4
5057 # define xx_txn_checkpoint(e,k,m,f) e->env->Env->txn_checkpoint(e->env->Env, k, m, f)
5058 # else
5059 # ifdef AT_LEAST_DB_3_1
5060 # define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m, 0)
5061 # else
5062 # define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m)
5063 # endif
5064 # endif
5065 #endif
5066 DualType
5067 xx_txn_checkpoint(txnp, kbyte, min, flags=0)
5068 BerkeleyDB::TxnMgr txnp
5069 long kbyte
5070 long min
5071 u_int32_t flags
5072 PREINIT:
5073 dMY_CXT;
5074
5075 HV *
5076 txn_stat(txnp)
5077 BerkeleyDB::TxnMgr txnp
5078 HV * RETVAL = NULL ;
5079 PREINIT:
5080 dMY_CXT;
5081 CODE:
5082 {
5083 DB_TXN_STAT * stat ;
5084 #ifdef AT_LEAST_DB_4
5085 if(txnp->env->Env->txn_stat(txnp->env->Env, &stat, 0) == 0) {
5086 #else
5087 # ifdef AT_LEAST_DB_3_3
5088 if(txn_stat(txnp->env->Env, &stat) == 0) {
5089 # else
5090 # if DB_VERSION_MAJOR == 2
5091 if(txn_stat(txnp->env->Env->tx_info, &stat, safemalloc) == 0) {
5092 # else
5093 if(txn_stat(txnp->env->Env, &stat, safemalloc) == 0) {
5094 # endif
5095 # endif
5096 #endif
5097 RETVAL = (HV*)sv_2mortal((SV*)newHV()) ;
5098 hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ;
5099 hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ;
5100 hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ;
5101 hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ;
5102 hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ;
5103 hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ;
5104 hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ;
5105 #if DB_VERSION_MAJOR > 2
5106 hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ;
5107 hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ;
5108 hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ;
5109 hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ;
5110 #endif
5111 safefree(stat) ;
5112 }
5113 }
5114 OUTPUT:
5115 RETVAL
5116
5117
5118 BerkeleyDB::TxnMgr
5119 txn_open(dir, flags, mode, dbenv)
5120 int flags
5121 const char * dir
5122 int mode
5123 BerkeleyDB::Env dbenv
5124 NOT_IMPLEMENTED_YET
5125
5126
5127 MODULE = BerkeleyDB::Txn PACKAGE = BerkeleyDB::Txn PREFIX = xx_
5128
5129 DualType
5130 status(tid)
5131 BerkeleyDB::Txn tid
5132 PREINIT:
5133 dMY_CXT;
5134 CODE:
5135 RETVAL = tid->Status ;
5136 OUTPUT:
5137 RETVAL
5138
5139 int
5140 set_timeout(txn, timeout, flags=0)
5141 BerkeleyDB::Txn txn
5142 db_timeout_t timeout
5143 u_int32_t flags
5144 PREINIT:
5145 dMY_CXT;
5146 INIT:
5147 ckActive_Transaction(txn->active) ;
5148 CODE:
5149 #ifndef AT_LEAST_DB_4
5150 softCrash("$env->set_timeout needs Berkeley DB 4.x or better") ;
5151 #else
5152 RETVAL = txn->Status = txn->txn->set_timeout(txn->txn, timeout, flags);
5153 #endif
5154 OUTPUT:
5155 RETVAL
5156
5157 int
5158 set_tx_max(env, max)
5159 BerkeleyDB::Env env
5160 u_int32_t max
5161 PREINIT:
5162 dMY_CXT;
5163 INIT:
5164 ckActive_Database(env->active) ;
5165 CODE:
5166 #ifndef AT_LEAST_DB_2_3
5167 softCrash("$env->set_tx_max needs Berkeley DB 2_3.x or better") ;
5168 #else
5169 dieIfEnvOpened(env, "set_tx_max");
5170 RETVAL = env->Status = env->Env->set_tx_max(env->Env, max);
5171 #endif
5172 OUTPUT:
5173 RETVAL
5174
5175 int
5176 get_tx_max(env, max)
5177 BerkeleyDB::Env env
5178 u_int32_t max = NO_INIT
5179 PREINIT:
5180 dMY_CXT;
5181 INIT:
5182 ckActive_Database(env->active) ;
5183 CODE:
5184 #ifndef AT_LEAST_DB_2_3
5185 softCrash("$env->get_tx_max needs Berkeley DB 2_3.x or better") ;
5186 #else
5187 RETVAL = env->Status = env->Env->get_tx_max(env->Env, &max);
5188 #endif
5189 OUTPUT:
5190 RETVAL
5191 max
5192
5193 void
5194 _DESTROY(tid)
5195 BerkeleyDB::Txn tid
5196 PREINIT:
5197 dMY_CXT;
5198 CODE:
5199 Trace(("In BerkeleyDB::Txn::_DESTROY txn [%d] active [%d] dirty=%d\n", tid->txn, tid->active, PL_dirty)) ;
5200 if (tid->active)
5201 #ifdef AT_LEAST_DB_4
5202 tid->txn->abort(tid->txn) ;
5203 #else
5204 txn_abort(tid->txn) ;
5205 #endif
5206 hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5207 Safefree(tid) ;
5208 Trace(("End of BerkeleyDB::Txn::DESTROY\n")) ;
5209
5210 #define xx_txn_unlink(d,f,e) txn_unlink(d,f,&(e->Env))
5211 DualType
5212 xx_txn_unlink(dir, force, dbenv)
5213 const char * dir
5214 int force
5215 BerkeleyDB::Env dbenv
5216 NOT_IMPLEMENTED_YET
5217
5218 #ifdef AT_LEAST_DB_4
5219 # define xx_txn_prepare(t) (t->Status = t->txn->prepare(t->txn, 0))
5220 #else
5221 # ifdef AT_LEAST_DB_3_3
5222 # define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn, 0))
5223 # else
5224 # define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn))
5225 # endif
5226 #endif
5227 DualType
5228 xx_txn_prepare(tid)
5229 BerkeleyDB::Txn tid
5230 PREINIT:
5231 dMY_CXT;
5232 INIT:
5233 ckActive_Transaction(tid->active) ;
5234
5235 #ifdef AT_LEAST_DB_4
5236 # define _txn_commit(t,flags) (t->Status = t->txn->commit(t->txn, flags))
5237 #else
5238 # if DB_VERSION_MAJOR == 2
5239 # define _txn_commit(t,flags) (t->Status = txn_commit(t->txn))
5240 # else
5241 # define _txn_commit(t, flags) (t->Status = txn_commit(t->txn, flags))
5242 # endif
5243 #endif
5244 DualType
5245 _txn_commit(tid, flags=0)
5246 u_int32_t flags
5247 BerkeleyDB::Txn tid
5248 PREINIT:
5249 dMY_CXT;
5250 INIT:
5251 ckActive_Transaction(tid->active) ;
5252 hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5253 tid->active = FALSE ;
5254
5255 #ifdef AT_LEAST_DB_4
5256 # define _txn_abort(t) (t->Status = t->txn->abort(t->txn))
5257 #else
5258 # define _txn_abort(t) (t->Status = txn_abort(t->txn))
5259 #endif
5260 DualType
5261 _txn_abort(tid)
5262 BerkeleyDB::Txn tid
5263 PREINIT:
5264 dMY_CXT;
5265 INIT:
5266 ckActive_Transaction(tid->active) ;
5267 hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5268 tid->active = FALSE ;
5269
5270 #ifdef AT_LEAST_DB_4
5271 # define _txn_discard(t,f) (t->Status = t->txn->discard(t->txn, f))
5272 #else
5273 # ifdef AT_LEAST_DB_3_3_4
5274 # define _txn_discard(t,f) (t->Status = txn_discard(t->txn, f))
5275 # else
5276 # define _txn_discard(t,f) (int)softCrash("txn_discard needs Berkeley DB 3.3.4 or better") ;
5277 # endif
5278 #endif
5279 DualType
5280 _txn_discard(tid, flags=0)
5281 BerkeleyDB::Txn tid
5282 u_int32_t flags
5283 PREINIT:
5284 dMY_CXT;
5285 INIT:
5286 ckActive_Transaction(tid->active) ;
5287 hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ;
5288 tid->active = FALSE ;
5289
5290 #ifdef AT_LEAST_DB_4
5291 # define xx_txn_id(t) t->txn->id(t->txn)
5292 #else
5293 # define xx_txn_id(t) txn_id(t->txn)
5294 #endif
5295 u_int32_t
5296 xx_txn_id(tid)
5297 BerkeleyDB::Txn tid
5298 PREINIT:
5299 dMY_CXT;
5300
5301 MODULE = BerkeleyDB::_tiedHash PACKAGE = BerkeleyDB::_tiedHash
5302
5303 int
5304 FIRSTKEY(db)
5305 BerkeleyDB::Common db
5306 PREINIT:
5307 dMY_CXT;
5308 CODE:
5309 {
5310 DBTKEY key ;
5311 DBT value ;
5312 DBC * cursor ;
5313
5314 /*
5315 TODO!
5316 set partial value to 0 - to eliminate the retrieval of
5317 the value need to store any existing partial settings &
5318 restore at the end.
5319
5320 */
5321 saveCurrentDB(db) ;
5322 DBT_clear(key) ;
5323 DBT_clear(value) ;
5324 /* If necessary create a cursor for FIRSTKEY/NEXTKEY use */
5325 if (!db->cursor &&
5326 (db->Status = db_cursor(db, db->txn, &cursor, 0)) == 0 )
5327 db->cursor = cursor ;
5328
5329 if (db->cursor)
5330 RETVAL = (db->Status) =
5331 ((db->cursor)->c_get)(db->cursor, &key, &value, DB_FIRST);
5332 else
5333 RETVAL = db->Status ;
5334 /* check for end of cursor */
5335 if (RETVAL == DB_NOTFOUND) {
5336 ((db->cursor)->c_close)(db->cursor) ;
5337 db->cursor = NULL ;
5338 }
5339 ST(0) = sv_newmortal();
5340 OutputKey(ST(0), key)
5341 }
5342
5343
5344
5345 int
5346 NEXTKEY(db, key)
5347 BerkeleyDB::Common db
5348 DBTKEY key = NO_INIT
5349 PREINIT:
5350 dMY_CXT;
5351 CODE:
5352 {
5353 DBT value ;
5354
5355 saveCurrentDB(db) ;
5356 DBT_clear(key) ;
5357 DBT_clear(value) ;
5358 key.flags = 0 ;
5359 RETVAL = (db->Status) =
5360 ((db->cursor)->c_get)(db->cursor, &key, &value, DB_NEXT);
5361
5362 /* check for end of cursor */
5363 if (RETVAL == DB_NOTFOUND) {
5364 ((db->cursor)->c_close)(db->cursor) ;
5365 db->cursor = NULL ;
5366 }
5367 ST(0) = sv_newmortal();
5368 OutputKey(ST(0), key)
5369 }
5370
5371 MODULE = BerkeleyDB::_tiedArray PACKAGE = BerkeleyDB::_tiedArray
5372
5373 I32
5374 FETCHSIZE(db)
5375 BerkeleyDB::Common db
5376 PREINIT:
5377 dMY_CXT;
5378 CODE:
5379 saveCurrentDB(db) ;
5380 RETVAL = GetArrayLength(db) ;
5381 OUTPUT:
5382 RETVAL
5383
5384
5385 MODULE = BerkeleyDB::Common PACKAGE = BerkeleyDB::Common
5386
5387 BerkeleyDB::Sequence
5388 db_create_sequence(db, flags=0)
5389 BerkeleyDB::Common db
5390 u_int32_t flags
5391 PREINIT:
5392 dMY_CXT;
5393 CODE:
5394 {
5395 #ifndef AT_LEAST_DB_4_3
5396 softCrash("$seq->create_sequence needs Berkeley DB 4.3.x or better") ;
5397 #else
5398 DB_SEQUENCE * seq ;
5399 saveCurrentDB(db);
5400 RETVAL = NULL;
5401 if (db_sequence_create(&seq, db->dbp, flags) == 0)
5402 {
5403 ZMALLOC(RETVAL, BerkeleyDB_Sequence_type);
5404 RETVAL->db = db;
5405 RETVAL->seq = seq;
5406 RETVAL->active = TRUE;
5407 ++ db->open_sequences ;
5408 }
5409 #endif
5410 }
5411 OUTPUT:
5412 RETVAL
5413
5414
5415 MODULE = BerkeleyDB::Sequence PACKAGE = BerkeleyDB::Sequence PREFIX = seq_
5416
5417 DualType
5418 open(seq, key, flags=0)
5419 BerkeleyDB::Sequence seq
5420 DBTKEY_seq key
5421 u_int32_t flags
5422 PREINIT:
5423 dMY_CXT;
5424 INIT:
5425 ckActive_Sequence(seq->active) ;
5426 CODE:
5427 #ifndef AT_LEAST_DB_4_3
5428 softCrash("$seq->create_sequence needs Berkeley DB 4.3.x or better") ;
5429 #else
5430 RETVAL = seq->seq->open(seq->seq, seq->db->txn, &key, flags);
5431 #endif
5432 OUTPUT:
5433 RETVAL
5434
5435 DualType
5436 close(seq,flags=0)
5437 BerkeleyDB::Sequence seq;
5438 u_int32_t flags;
5439 PREINIT:
5440 dMY_CXT;
5441 INIT:
5442 ckActive_Sequence(seq->active) ;
5443 CODE:
5444 #ifndef AT_LEAST_DB_4_3
5445 softCrash("$seq->close needs Berkeley DB 4.3.x or better") ;
5446 #else
5447 RETVAL = 0;
5448 if (seq->active) {
5449 -- seq->db->open_sequences;
5450 RETVAL = (seq->seq->close)(seq->seq, flags);
5451 }
5452 seq->active = FALSE;
5453 #endif
5454 OUTPUT:
5455 RETVAL
5456
5457 DualType
5458 remove(seq,flags=0)
5459 BerkeleyDB::Sequence seq;
5460 u_int32_t flags;
5461 PREINIT:
5462 dMY_CXT;
5463 INIT:
5464 ckActive_Sequence(seq->active) ;
5465 CODE:
5466 #ifndef AT_LEAST_DB_4_3
5467 softCrash("$seq->remove needs Berkeley DB 4.3.x or better") ;
5468 #else
5469 RETVAL = 0;
5470 if (seq->active)
5471 RETVAL = seq->seq->remove(seq->seq, seq->db->txn, flags);
5472 seq->active = FALSE;
5473 #endif
5474 OUTPUT:
5475 RETVAL
5476
5477 void
5478 DESTROY(seq)
5479 BerkeleyDB::Sequence seq
5480 PREINIT:
5481 dMY_CXT;
5482 CODE:
5483 #ifdef AT_LEAST_DB_4_3
5484 if (seq->active)
5485 (seq->seq->close)(seq->seq, 0);
5486 Safefree(seq);
5487 #endif
5488
5489 DualType
5490 get(seq, element, delta=1, flags=0)
5491 BerkeleyDB::Sequence seq;
5492 IV delta;
5493 db_seq_t element = NO_INIT
5494 u_int32_t flags;
5495 PREINIT:
5496 dMY_CXT;
5497 INIT:
5498 ckActive_Sequence(seq->active) ;
5499 CODE:
5500 #ifndef AT_LEAST_DB_4_3
5501 softCrash("$seq->get needs Berkeley DB 4.3.x or better") ;
5502 #else
5503 RETVAL = seq->seq->get(seq->seq, seq->db->txn, delta, &element, flags);
5504 #endif
5505 OUTPUT:
5506 RETVAL
5507 element
5508
5509 DualType
5510 get_key(seq, key)
5511 BerkeleyDB::Sequence seq;
5512 DBTKEY_seq key = NO_INIT
5513 PREINIT:
5514 dMY_CXT;
5515 INIT:
5516 ckActive_Sequence(seq->active) ;
5517 CODE:
5518 #ifndef AT_LEAST_DB_4_3
5519 softCrash("$seq->get_key needs Berkeley DB 4.3.x or better") ;
5520 #else
5521 DBT_clear(key);
5522 RETVAL = seq->seq->get_key(seq->seq, &key);
5523 #endif
5524 OUTPUT:
5525 RETVAL
5526 key
5527
5528 DualType
5529 initial_value(seq, low, high=0)
5530 BerkeleyDB::Sequence seq;
5531 int low
5532 int high
5533 PREINIT:
5534 dMY_CXT;
5535 INIT:
5536 ckActive_Sequence(seq->active) ;
5537 CODE:
5538 #ifndef AT_LEAST_DB_4_3
5539 softCrash("$seq->initial_value needs Berkeley DB 4.3.x or better") ;
5540 #else
5541 RETVAL = seq->seq->initial_value(seq->seq, (db_seq_t)(high << 32 + low));
5542 #endif
5543 OUTPUT:
5544 RETVAL
5545
5546 DualType
5547 set_cachesize(seq, size)
5548 BerkeleyDB::Sequence seq;
5549 int32_t size
5550 PREINIT:
5551 dMY_CXT;
5552 INIT:
5553 ckActive_Sequence(seq->active) ;
5554 CODE:
5555 #ifndef AT_LEAST_DB_4_3
5556 softCrash("$seq->set_cachesize needs Berkeley DB 4.3.x or better") ;
5557 #else
5558 RETVAL = seq->seq->set_cachesize(seq->seq, size);
5559 #endif
5560 OUTPUT:
5561 RETVAL
5562
5563 DualType
5564 get_cachesize(seq, size)
5565 BerkeleyDB::Sequence seq;
5566 int32_t size = NO_INIT
5567 PREINIT:
5568 dMY_CXT;
5569 INIT:
5570 ckActive_Sequence(seq->active) ;
5571 CODE:
5572 #ifndef AT_LEAST_DB_4_3
5573 softCrash("$seq->get_cachesize needs Berkeley DB 4.3.x or better") ;
5574 #else
5575 RETVAL = seq->seq->get_cachesize(seq->seq, &size);
5576 #endif
5577 OUTPUT:
5578 RETVAL
5579 size
5580
5581 DualType
5582 set_flags(seq, flags)
5583 BerkeleyDB::Sequence seq;
5584 u_int32_t flags
5585 PREINIT:
5586 dMY_CXT;
5587 INIT:
5588 ckActive_Sequence(seq->active) ;
5589 CODE:
5590 #ifndef AT_LEAST_DB_4_3
5591 softCrash("$seq->set_flags needs Berkeley DB 4.3.x or better") ;
5592 #else
5593 RETVAL = seq->seq->set_flags(seq->seq, flags);
5594 #endif
5595 OUTPUT:
5596 RETVAL
5597
5598 DualType
5599 get_flags(seq, flags)
5600 BerkeleyDB::Sequence seq;
5601 u_int32_t flags = NO_INIT
5602 PREINIT:
5603 dMY_CXT;
5604 INIT:
5605 ckActive_Sequence(seq->active) ;
5606 CODE:
5607 #ifndef AT_LEAST_DB_4_3
5608 softCrash("$seq->get_flags needs Berkeley DB 4.3.x or better") ;
5609 #else
5610 RETVAL = seq->seq->get_flags(seq->seq, &flags);
5611 #endif
5612 OUTPUT:
5613 RETVAL
5614 flags
5615
5616 DualType
5617 set_range(seq)
5618 BerkeleyDB::Sequence seq;
5619 NOT_IMPLEMENTED_YET
5620
5621 DualType
5622 stat(seq)
5623 BerkeleyDB::Sequence seq;
5624 NOT_IMPLEMENTED_YET
5625
5626
5627 MODULE = BerkeleyDB PACKAGE = BerkeleyDB
5628
5629 BOOT:
5630 {
5631 #ifdef dTHX
5632 dTHX;
5633 #endif
5634 SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ;
5635 SV * version_sv = perl_get_sv("BerkeleyDB::db_version", GV_ADD|GV_ADDMULTI) ;
5636 SV * ver_sv = perl_get_sv("BerkeleyDB::db_ver", GV_ADD|GV_ADDMULTI) ;
5637 int Major, Minor, Patch ;
5638 MY_CXT_INIT;
5639 (void)db_version(&Major, &Minor, &Patch) ;
5640 /* Check that the versions of db.h and libdb.a are the same */
5641 if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR
5642 || Patch != DB_VERSION_PATCH)
5643 croak("\nBerkeleyDB needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n",
5644 DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH,
5645 Major, Minor, Patch) ;
5646
5647 if (Major < 2 || (Major == 2 && Minor < 6))
5648 {
5649 croak("BerkeleyDB needs Berkeley DB 2.6 or greater. This is %d.%d.%d\n",
5650 Major, Minor, Patch) ;
5651 }
5652 sv_setpvf(version_sv, "%d.%d", Major, Minor) ;
5653 sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ;
5654 sv_setpv(sv_err, "");
5655
5656 DBT_clear(empty) ;
5657 empty.data = &zero ;
5658 empty.size = sizeof(db_recno_t) ;
5659 empty.flags = 0 ;
5660
5661 }
5662
5663