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