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