1 2package BerkeleyDB; 3 4 5# Copyright (c) 1997-2011 Paul Marquess. All rights reserved. 6# This program is free software; you can redistribute it and/or 7# modify it under the same terms as Perl itself. 8# 9 10# The documentation for this module is at the bottom of this file, 11# after the line __END__. 12 13BEGIN { require 5.005 } 14 15use strict; 16use Carp; 17use vars qw($VERSION @ISA @EXPORT $AUTOLOAD 18 $use_XSLoader); 19 20$VERSION = '0.50'; 21 22require Exporter; 23#require DynaLoader; 24require AutoLoader; 25 26BEGIN { 27 $use_XSLoader = 1 ; 28 { local $SIG{__DIE__} ; eval { require XSLoader } ; } 29 30 if ($@) { 31 $use_XSLoader = 0 ; 32 require DynaLoader; 33 @ISA = qw(DynaLoader); 34 } 35} 36 37@ISA = qw(Exporter DynaLoader); 38# Items to export into callers namespace by default. Note: do not export 39# names by default without a very good reason. Use EXPORT_OK instead. 40# Do not simply export all your public functions/methods/constants. 41 42# NOTE -- Do not add to @EXPORT directly. It is written by mkconsts 43@EXPORT = qw( 44 DB2_AM_EXCL 45 DB2_AM_INTEXCL 46 DB2_AM_NOWAIT 47 DB_AFTER 48 DB_AGGRESSIVE 49 DB_ALREADY_ABORTED 50 DB_APPEND 51 DB_APPLY_LOGREG 52 DB_APP_INIT 53 DB_ARCH_ABS 54 DB_ARCH_DATA 55 DB_ARCH_LOG 56 DB_ARCH_REMOVE 57 DB_ASSOC_CREATE 58 DB_ASSOC_IMMUTABLE_KEY 59 DB_AUTO_COMMIT 60 DB_BACKUP_CLEAN 61 DB_BACKUP_FILES 62 DB_BACKUP_NO_LOGS 63 DB_BACKUP_READ_COUNT 64 DB_BACKUP_READ_SLEEP 65 DB_BACKUP_SINGLE_DIR 66 DB_BACKUP_SIZE 67 DB_BACKUP_UPDATE 68 DB_BACKUP_WRITE_DIRECT 69 DB_BEFORE 70 DB_BOOTSTRAP_HELPER 71 DB_BTREE 72 DB_BTREEMAGIC 73 DB_BTREEOLDVER 74 DB_BTREEVERSION 75 DB_BUFFER_SMALL 76 DB_CACHED_COUNTS 77 DB_CDB_ALLDB 78 DB_CHECKPOINT 79 DB_CHKSUM 80 DB_CHKSUM_SHA1 81 DB_CKP_INTERNAL 82 DB_CLIENT 83 DB_CL_WRITER 84 DB_COMMIT 85 DB_COMPACT_FLAGS 86 DB_CONSUME 87 DB_CONSUME_WAIT 88 DB_CREATE 89 DB_CURLSN 90 DB_CURRENT 91 DB_CURSOR_BULK 92 DB_CURSOR_TRANSIENT 93 DB_CXX_NO_EXCEPTIONS 94 DB_DATABASE_LOCK 95 DB_DATABASE_LOCKING 96 DB_DEGREE_2 97 DB_DELETED 98 DB_DELIMITER 99 DB_DIRECT 100 DB_DIRECT_DB 101 DB_DIRECT_LOG 102 DB_DIRTY_READ 103 DB_DONOTINDEX 104 DB_DSYNC_DB 105 DB_DSYNC_LOG 106 DB_DUP 107 DB_DUPCURSOR 108 DB_DUPSORT 109 DB_DURABLE_UNKNOWN 110 DB_EID_BROADCAST 111 DB_EID_INVALID 112 DB_EID_MASTER 113 DB_ENCRYPT 114 DB_ENCRYPT_AES 115 DB_ENV_APPINIT 116 DB_ENV_AUTO_COMMIT 117 DB_ENV_CDB 118 DB_ENV_CDB_ALLDB 119 DB_ENV_CREATE 120 DB_ENV_DATABASE_LOCKING 121 DB_ENV_DBLOCAL 122 DB_ENV_DIRECT_DB 123 DB_ENV_DIRECT_LOG 124 DB_ENV_DSYNC_DB 125 DB_ENV_DSYNC_LOG 126 DB_ENV_FAILCHK 127 DB_ENV_FATAL 128 DB_ENV_HOTBACKUP 129 DB_ENV_LOCKDOWN 130 DB_ENV_LOCKING 131 DB_ENV_LOGGING 132 DB_ENV_LOG_AUTOREMOVE 133 DB_ENV_LOG_INMEMORY 134 DB_ENV_MULTIVERSION 135 DB_ENV_NOFLUSH 136 DB_ENV_NOLOCKING 137 DB_ENV_NOMMAP 138 DB_ENV_NOPANIC 139 DB_ENV_NO_OUTPUT_SET 140 DB_ENV_OPEN_CALLED 141 DB_ENV_OVERWRITE 142 DB_ENV_PRIVATE 143 DB_ENV_RECOVER_FATAL 144 DB_ENV_REF_COUNTED 145 DB_ENV_REGION_INIT 146 DB_ENV_REP_CLIENT 147 DB_ENV_REP_LOGSONLY 148 DB_ENV_REP_MASTER 149 DB_ENV_RPCCLIENT 150 DB_ENV_RPCCLIENT_GIVEN 151 DB_ENV_STANDALONE 152 DB_ENV_SYSTEM_MEM 153 DB_ENV_THREAD 154 DB_ENV_TIME_NOTGRANTED 155 DB_ENV_TXN 156 DB_ENV_TXN_NOSYNC 157 DB_ENV_TXN_NOT_DURABLE 158 DB_ENV_TXN_NOWAIT 159 DB_ENV_TXN_SNAPSHOT 160 DB_ENV_TXN_WRITE_NOSYNC 161 DB_ENV_USER_ALLOC 162 DB_ENV_YIELDCPU 163 DB_EVENT_NOT_HANDLED 164 DB_EVENT_NO_SUCH_EVENT 165 DB_EVENT_PANIC 166 DB_EVENT_REG_ALIVE 167 DB_EVENT_REG_PANIC 168 DB_EVENT_REP_CLIENT 169 DB_EVENT_REP_CONNECT_BROKEN 170 DB_EVENT_REP_CONNECT_ESTD 171 DB_EVENT_REP_CONNECT_TRY_FAILED 172 DB_EVENT_REP_DUPMASTER 173 DB_EVENT_REP_ELECTED 174 DB_EVENT_REP_ELECTION_FAILED 175 DB_EVENT_REP_INIT_DONE 176 DB_EVENT_REP_JOIN_FAILURE 177 DB_EVENT_REP_LOCAL_SITE_REMOVED 178 DB_EVENT_REP_MASTER 179 DB_EVENT_REP_MASTER_FAILURE 180 DB_EVENT_REP_NEWMASTER 181 DB_EVENT_REP_PERM_FAILED 182 DB_EVENT_REP_SITE_ADDED 183 DB_EVENT_REP_SITE_REMOVED 184 DB_EVENT_REP_STARTUPDONE 185 DB_EVENT_REP_WOULD_ROLLBACK 186 DB_EVENT_WRITE_FAILED 187 DB_EXCL 188 DB_EXTENT 189 DB_FAILCHK 190 DB_FAILCHK_ISALIVE 191 DB_FAST_STAT 192 DB_FCNTL_LOCKING 193 DB_FILEOPEN 194 DB_FILE_ID_LEN 195 DB_FIRST 196 DB_FIXEDLEN 197 DB_FLUSH 198 DB_FORCE 199 DB_FORCESYNC 200 DB_FOREIGN_ABORT 201 DB_FOREIGN_CASCADE 202 DB_FOREIGN_CONFLICT 203 DB_FOREIGN_NULLIFY 204 DB_FREELIST_ONLY 205 DB_FREE_SPACE 206 DB_GETREC 207 DB_GET_BOTH 208 DB_GET_BOTHC 209 DB_GET_BOTH_LTE 210 DB_GET_BOTH_RANGE 211 DB_GET_RECNO 212 DB_GID_SIZE 213 DB_GROUP_CREATOR 214 DB_HANDLE_LOCK 215 DB_HASH 216 DB_HASHMAGIC 217 DB_HASHOLDVER 218 DB_HASHVERSION 219 DB_HEAP 220 DB_HEAPMAGIC 221 DB_HEAPOLDVER 222 DB_HEAPVERSION 223 DB_HEAP_FULL 224 DB_HEAP_RID_SZ 225 DB_HOTBACKUP_IN_PROGRESS 226 DB_IGNORE_LEASE 227 DB_IMMUTABLE_KEY 228 DB_INCOMPLETE 229 DB_INIT_CDB 230 DB_INIT_LOCK 231 DB_INIT_LOG 232 DB_INIT_MPOOL 233 DB_INIT_MUTEX 234 DB_INIT_REP 235 DB_INIT_TXN 236 DB_INORDER 237 DB_INTERNAL_DB 238 DB_INTERNAL_PERSISTENT_DB 239 DB_INTERNAL_TEMPORARY_DB 240 DB_JAVA_CALLBACK 241 DB_JOINENV 242 DB_JOIN_ITEM 243 DB_JOIN_NOSORT 244 DB_KEYEMPTY 245 DB_KEYEXIST 246 DB_KEYFIRST 247 DB_KEYLAST 248 DB_LAST 249 DB_LEGACY 250 DB_LOCAL_SITE 251 DB_LOCKDOWN 252 DB_LOCKMAGIC 253 DB_LOCKVERSION 254 DB_LOCK_ABORT 255 DB_LOCK_CHECK 256 DB_LOCK_CONFLICT 257 DB_LOCK_DEADLOCK 258 DB_LOCK_DEFAULT 259 DB_LOCK_DUMP 260 DB_LOCK_EXPIRE 261 DB_LOCK_FREE_LOCKER 262 DB_LOCK_GET 263 DB_LOCK_GET_TIMEOUT 264 DB_LOCK_IGNORE_REC 265 DB_LOCK_INHERIT 266 DB_LOCK_MAXLOCKS 267 DB_LOCK_MAXWRITE 268 DB_LOCK_MINLOCKS 269 DB_LOCK_MINWRITE 270 DB_LOCK_NORUN 271 DB_LOCK_NOTEXIST 272 DB_LOCK_NOTGRANTED 273 DB_LOCK_NOTHELD 274 DB_LOCK_NOWAIT 275 DB_LOCK_OLDEST 276 DB_LOCK_PUT 277 DB_LOCK_PUT_ALL 278 DB_LOCK_PUT_OBJ 279 DB_LOCK_PUT_READ 280 DB_LOCK_RANDOM 281 DB_LOCK_RECORD 282 DB_LOCK_REMOVE 283 DB_LOCK_RIW_N 284 DB_LOCK_RW_N 285 DB_LOCK_SET_TIMEOUT 286 DB_LOCK_SWITCH 287 DB_LOCK_TIMEOUT 288 DB_LOCK_TRADE 289 DB_LOCK_UPGRADE 290 DB_LOCK_UPGRADE_WRITE 291 DB_LOCK_YOUNGEST 292 DB_LOGCHKSUM 293 DB_LOGC_BUF_SIZE 294 DB_LOGFILEID_INVALID 295 DB_LOGMAGIC 296 DB_LOGOLDVER 297 DB_LOGVERSION 298 DB_LOGVERSION_LATCHING 299 DB_LOG_AUTOREMOVE 300 DB_LOG_AUTO_REMOVE 301 DB_LOG_BUFFER_FULL 302 DB_LOG_CHKPNT 303 DB_LOG_COMMIT 304 DB_LOG_DIRECT 305 DB_LOG_DISK 306 DB_LOG_DSYNC 307 DB_LOG_INMEMORY 308 DB_LOG_IN_MEMORY 309 DB_LOG_LOCKED 310 DB_LOG_NOCOPY 311 DB_LOG_NOT_DURABLE 312 DB_LOG_NO_DATA 313 DB_LOG_PERM 314 DB_LOG_RESEND 315 DB_LOG_SILENT_ERR 316 DB_LOG_VERIFY_BAD 317 DB_LOG_VERIFY_CAF 318 DB_LOG_VERIFY_DBFILE 319 DB_LOG_VERIFY_ERR 320 DB_LOG_VERIFY_FORWARD 321 DB_LOG_VERIFY_INTERR 322 DB_LOG_VERIFY_PARTIAL 323 DB_LOG_VERIFY_VERBOSE 324 DB_LOG_VERIFY_WARNING 325 DB_LOG_WRNOSYNC 326 DB_LOG_ZERO 327 DB_MAX_PAGES 328 DB_MAX_RECORDS 329 DB_MEM_LOCK 330 DB_MEM_LOCKER 331 DB_MEM_LOCKOBJECT 332 DB_MEM_LOGID 333 DB_MEM_THREAD 334 DB_MEM_TRANSACTION 335 DB_MPOOL_CLEAN 336 DB_MPOOL_CREATE 337 DB_MPOOL_DIRTY 338 DB_MPOOL_DISCARD 339 DB_MPOOL_EDIT 340 DB_MPOOL_EXTENT 341 DB_MPOOL_FREE 342 DB_MPOOL_LAST 343 DB_MPOOL_NEW 344 DB_MPOOL_NEW_GROUP 345 DB_MPOOL_NOFILE 346 DB_MPOOL_NOLOCK 347 DB_MPOOL_PRIVATE 348 DB_MPOOL_TRY 349 DB_MPOOL_UNLINK 350 DB_MULTIPLE 351 DB_MULTIPLE_KEY 352 DB_MULTIVERSION 353 DB_MUTEXDEBUG 354 DB_MUTEXLOCKS 355 DB_MUTEX_ALLOCATED 356 DB_MUTEX_LOCKED 357 DB_MUTEX_LOGICAL_LOCK 358 DB_MUTEX_PROCESS_ONLY 359 DB_MUTEX_SELF_BLOCK 360 DB_MUTEX_SHARED 361 DB_MUTEX_THREAD 362 DB_NEEDSPLIT 363 DB_NEXT 364 DB_NEXT_DUP 365 DB_NEXT_NODUP 366 DB_NOCOPY 367 DB_NODUPDATA 368 DB_NOERROR 369 DB_NOFLUSH 370 DB_NOLOCKING 371 DB_NOMMAP 372 DB_NOORDERCHK 373 DB_NOOVERWRITE 374 DB_NOPANIC 375 DB_NORECURSE 376 DB_NOSERVER 377 DB_NOSERVER_HOME 378 DB_NOSERVER_ID 379 DB_NOSYNC 380 DB_NOTFOUND 381 DB_NO_AUTO_COMMIT 382 DB_NO_CHECKPOINT 383 DB_ODDFILESIZE 384 DB_OK_BTREE 385 DB_OK_HASH 386 DB_OK_HEAP 387 DB_OK_QUEUE 388 DB_OK_RECNO 389 DB_OLD_VERSION 390 DB_OPEN_CALLED 391 DB_OPFLAGS_MASK 392 DB_ORDERCHKONLY 393 DB_OVERWRITE 394 DB_OVERWRITE_DUP 395 DB_PAD 396 DB_PAGEYIELD 397 DB_PAGE_LOCK 398 DB_PAGE_NOTFOUND 399 DB_PANIC_ENVIRONMENT 400 DB_PERMANENT 401 DB_POSITION 402 DB_POSITIONI 403 DB_PREV 404 DB_PREV_DUP 405 DB_PREV_NODUP 406 DB_PRINTABLE 407 DB_PRIORITY_DEFAULT 408 DB_PRIORITY_HIGH 409 DB_PRIORITY_LOW 410 DB_PRIORITY_UNCHANGED 411 DB_PRIORITY_VERY_HIGH 412 DB_PRIORITY_VERY_LOW 413 DB_PRIVATE 414 DB_PR_HEADERS 415 DB_PR_PAGE 416 DB_PR_RECOVERYTEST 417 DB_QAMMAGIC 418 DB_QAMOLDVER 419 DB_QAMVERSION 420 DB_QUEUE 421 DB_RDONLY 422 DB_RDWRMASTER 423 DB_READ_COMMITTED 424 DB_READ_UNCOMMITTED 425 DB_RECNO 426 DB_RECNUM 427 DB_RECORDCOUNT 428 DB_RECORD_LOCK 429 DB_RECOVER 430 DB_RECOVER_FATAL 431 DB_REGION_ANON 432 DB_REGION_INIT 433 DB_REGION_MAGIC 434 DB_REGION_NAME 435 DB_REGISTER 436 DB_REGISTERED 437 DB_RENAMEMAGIC 438 DB_RENUMBER 439 DB_REPFLAGS_MASK 440 DB_REPMGR_ACKS_ALL 441 DB_REPMGR_ACKS_ALL_AVAILABLE 442 DB_REPMGR_ACKS_ALL_PEERS 443 DB_REPMGR_ACKS_NONE 444 DB_REPMGR_ACKS_ONE 445 DB_REPMGR_ACKS_ONE_PEER 446 DB_REPMGR_ACKS_QUORUM 447 DB_REPMGR_CONF_2SITE_STRICT 448 DB_REPMGR_CONF_ELECTIONS 449 DB_REPMGR_CONNECTED 450 DB_REPMGR_DISCONNECTED 451 DB_REPMGR_ISPEER 452 DB_REPMGR_NEED_RESPONSE 453 DB_REPMGR_PEER 454 DB_REP_ACK_TIMEOUT 455 DB_REP_ANYWHERE 456 DB_REP_BULKOVF 457 DB_REP_CHECKPOINT_DELAY 458 DB_REP_CLIENT 459 DB_REP_CONF_AUTOINIT 460 DB_REP_CONF_AUTOROLLBACK 461 DB_REP_CONF_BULK 462 DB_REP_CONF_DELAYCLIENT 463 DB_REP_CONF_INMEM 464 DB_REP_CONF_LEASE 465 DB_REP_CONF_NOAUTOINIT 466 DB_REP_CONF_NOWAIT 467 DB_REP_CONNECTION_RETRY 468 DB_REP_CREATE 469 DB_REP_DEFAULT_PRIORITY 470 DB_REP_DUPMASTER 471 DB_REP_EGENCHG 472 DB_REP_ELECTION 473 DB_REP_ELECTION_RETRY 474 DB_REP_ELECTION_TIMEOUT 475 DB_REP_FULL_ELECTION 476 DB_REP_FULL_ELECTION_TIMEOUT 477 DB_REP_HANDLE_DEAD 478 DB_REP_HEARTBEAT_MONITOR 479 DB_REP_HEARTBEAT_SEND 480 DB_REP_HOLDELECTION 481 DB_REP_IGNORE 482 DB_REP_ISPERM 483 DB_REP_JOIN_FAILURE 484 DB_REP_LEASE_EXPIRED 485 DB_REP_LEASE_TIMEOUT 486 DB_REP_LOCKOUT 487 DB_REP_LOGREADY 488 DB_REP_LOGSONLY 489 DB_REP_MASTER 490 DB_REP_NEWMASTER 491 DB_REP_NEWSITE 492 DB_REP_NOBUFFER 493 DB_REP_NOTPERM 494 DB_REP_OUTDATED 495 DB_REP_PAGEDONE 496 DB_REP_PAGELOCKED 497 DB_REP_PERMANENT 498 DB_REP_REREQUEST 499 DB_REP_STARTUPDONE 500 DB_REP_UNAVAIL 501 DB_REP_WOULDROLLBACK 502 DB_REVSPLITOFF 503 DB_RMW 504 DB_RPCCLIENT 505 DB_RPC_SERVERPROG 506 DB_RPC_SERVERVERS 507 DB_RUNRECOVERY 508 DB_SALVAGE 509 DB_SA_SKIPFIRSTKEY 510 DB_SA_UNKNOWNKEY 511 DB_SECONDARY_BAD 512 DB_SEQUENCE_OLDVER 513 DB_SEQUENCE_VERSION 514 DB_SEQUENTIAL 515 DB_SEQ_DEC 516 DB_SEQ_INC 517 DB_SEQ_RANGE_SET 518 DB_SEQ_WRAP 519 DB_SEQ_WRAPPED 520 DB_SET 521 DB_SET_LOCK_TIMEOUT 522 DB_SET_LTE 523 DB_SET_RANGE 524 DB_SET_RECNO 525 DB_SET_REG_TIMEOUT 526 DB_SET_TXN_NOW 527 DB_SET_TXN_TIMEOUT 528 DB_SHALLOW_DUP 529 DB_SNAPSHOT 530 DB_SPARE_FLAG 531 DB_STAT_ALL 532 DB_STAT_ALLOC 533 DB_STAT_CLEAR 534 DB_STAT_LOCK_CONF 535 DB_STAT_LOCK_LOCKERS 536 DB_STAT_LOCK_OBJECTS 537 DB_STAT_LOCK_PARAMS 538 DB_STAT_MEMP_HASH 539 DB_STAT_MEMP_NOERROR 540 DB_STAT_NOERROR 541 DB_STAT_SUBSYSTEM 542 DB_STAT_SUMMARY 543 DB_ST_DUPOK 544 DB_ST_DUPSET 545 DB_ST_DUPSORT 546 DB_ST_IS_RECNO 547 DB_ST_OVFL_LEAF 548 DB_ST_RECNUM 549 DB_ST_RELEN 550 DB_ST_TOPLEVEL 551 DB_SURPRISE_KID 552 DB_SWAPBYTES 553 DB_SYSTEM_MEM 554 DB_TEMPORARY 555 DB_TEST_ELECTINIT 556 DB_TEST_ELECTSEND 557 DB_TEST_ELECTVOTE1 558 DB_TEST_ELECTVOTE2 559 DB_TEST_ELECTWAIT1 560 DB_TEST_ELECTWAIT2 561 DB_TEST_POSTDESTROY 562 DB_TEST_POSTLOG 563 DB_TEST_POSTLOGMETA 564 DB_TEST_POSTOPEN 565 DB_TEST_POSTRENAME 566 DB_TEST_POSTSYNC 567 DB_TEST_PREDESTROY 568 DB_TEST_PREOPEN 569 DB_TEST_PRERENAME 570 DB_TEST_RECYCLE 571 DB_TEST_SUBDB_LOCKS 572 DB_THREAD 573 DB_THREADID_STRLEN 574 DB_TIMEOUT 575 DB_TIME_NOTGRANTED 576 DB_TRUNCATE 577 DB_TXNMAGIC 578 DB_TXNVERSION 579 DB_TXN_ABORT 580 DB_TXN_APPLY 581 DB_TXN_BACKWARD_ROLL 582 DB_TXN_BULK 583 DB_TXN_CKP 584 DB_TXN_FAMILY 585 DB_TXN_FORWARD_ROLL 586 DB_TXN_LOCK 587 DB_TXN_LOCK_2PL 588 DB_TXN_LOCK_MASK 589 DB_TXN_LOCK_OPTIMIST 590 DB_TXN_LOCK_OPTIMISTIC 591 DB_TXN_LOG_MASK 592 DB_TXN_LOG_REDO 593 DB_TXN_LOG_UNDO 594 DB_TXN_LOG_UNDOREDO 595 DB_TXN_LOG_VERIFY 596 DB_TXN_NOSYNC 597 DB_TXN_NOT_DURABLE 598 DB_TXN_NOWAIT 599 DB_TXN_OPENFILES 600 DB_TXN_POPENFILES 601 DB_TXN_PRINT 602 DB_TXN_REDO 603 DB_TXN_SNAPSHOT 604 DB_TXN_SYNC 605 DB_TXN_TOKEN_SIZE 606 DB_TXN_UNDO 607 DB_TXN_WAIT 608 DB_TXN_WRITE_NOSYNC 609 DB_UNKNOWN 610 DB_UNREF 611 DB_UPDATE_SECONDARY 612 DB_UPGRADE 613 DB_USERCOPY_GETDATA 614 DB_USERCOPY_SETDATA 615 DB_USE_ENVIRON 616 DB_USE_ENVIRON_ROOT 617 DB_VERB_BACKUP 618 DB_VERB_CHKPOINT 619 DB_VERB_DEADLOCK 620 DB_VERB_FILEOPS 621 DB_VERB_FILEOPS_ALL 622 DB_VERB_RECOVERY 623 DB_VERB_REGISTER 624 DB_VERB_REPLICATION 625 DB_VERB_REPMGR_CONNFAIL 626 DB_VERB_REPMGR_MISC 627 DB_VERB_REP_ELECT 628 DB_VERB_REP_LEASE 629 DB_VERB_REP_MISC 630 DB_VERB_REP_MSGS 631 DB_VERB_REP_SYNC 632 DB_VERB_REP_SYSTEM 633 DB_VERB_REP_TEST 634 DB_VERB_WAITSFOR 635 DB_VERIFY 636 DB_VERIFY_BAD 637 DB_VERIFY_FATAL 638 DB_VERIFY_PARTITION 639 DB_VERSION_FAMILY 640 DB_VERSION_FULL_STRING 641 DB_VERSION_MAJOR 642 DB_VERSION_MINOR 643 DB_VERSION_MISMATCH 644 DB_VERSION_PATCH 645 DB_VERSION_RELEASE 646 DB_VERSION_STRING 647 DB_VRFY_FLAGMASK 648 DB_WRITECURSOR 649 DB_WRITELOCK 650 DB_WRITEOPEN 651 DB_WRNOSYNC 652 DB_XA_CREATE 653 DB_XIDDATASIZE 654 DB_YIELDCPU 655 DB_debug_FLAG 656 DB_user_BEGIN 657 LOGREC_ARG 658 LOGREC_DATA 659 LOGREC_DB 660 LOGREC_DBOP 661 LOGREC_DBT 662 LOGREC_Done 663 LOGREC_HDR 664 LOGREC_LOCKS 665 LOGREC_OP 666 LOGREC_PGDBT 667 LOGREC_PGDDBT 668 LOGREC_PGLIST 669 LOGREC_POINTER 670 LOGREC_TIME 671 ); 672 673sub AUTOLOAD { 674 my($constname); 675 ($constname = $AUTOLOAD) =~ s/.*:://; 676 my ($error, $val) = constant($constname); 677 Carp::croak $error if $error; 678 no strict 'refs'; 679 *{$AUTOLOAD} = sub { $val }; 680 goto &{$AUTOLOAD}; 681} 682 683#bootstrap BerkeleyDB $VERSION; 684if ($use_XSLoader) 685 { XSLoader::load("BerkeleyDB", $VERSION)} 686else 687 { bootstrap BerkeleyDB $VERSION } 688 689# Preloaded methods go here. 690 691 692sub ParseParameters($@) 693{ 694 my ($default, @rest) = @_ ; 695 my (%got) = %$default ; 696 my (@Bad) ; 697 my ($key, $value) ; 698 my $sub = (caller(1))[3] ; 699 my %options = () ; 700 local ($Carp::CarpLevel) = 1 ; 701 702 # allow the options to be passed as a hash reference or 703 # as the complete hash. 704 if (@rest == 1) { 705 706 croak "$sub: parameter is not a reference to a hash" 707 if ref $rest[0] ne "HASH" ; 708 709 %options = %{ $rest[0] } ; 710 } 711 elsif (@rest >= 2 && @rest % 2 == 0) { 712 %options = @rest ; 713 } 714 elsif (@rest > 0) { 715 croak "$sub: malformed option list"; 716 } 717 718 while (($key, $value) = each %options) 719 { 720 $key =~ s/^-// ; 721 722 if (exists $default->{$key}) 723 { $got{$key} = $value } 724 else 725 { push (@Bad, $key) } 726 } 727 728 if (@Bad) { 729 my ($bad) = join(", ", @Bad) ; 730 croak "unknown key value(s) $bad" ; 731 } 732 733 return \%got ; 734} 735 736sub parseEncrypt 737{ 738 my $got = shift ; 739 740 741 if (defined $got->{Encrypt}) { 742 croak("Encrypt parameter must be a hash reference") 743 if !ref $got->{Encrypt} || ref $got->{Encrypt} ne 'HASH' ; 744 745 my %config = %{ $got->{Encrypt} } ; 746 747 my $p = BerkeleyDB::ParseParameters({ 748 Password => undef, 749 Flags => undef, 750 }, %config); 751 752 croak("Must specify Password and Flags with Encrypt parameter") 753 if ! (defined $p->{Password} && defined $p->{Flags}); 754 755 $got->{"Enc_Passwd"} = $p->{Password}; 756 $got->{"Enc_Flags"} = $p->{Flags}; 757 } 758} 759 760use UNIVERSAL ; 761 762sub env_remove 763{ 764 # Usage: 765 # 766 # $env = BerkeleyDB::env_remove 767 # [ -Home => $path, ] 768 # [ -Config => { name => value, name => value } 769 # [ -Flags => DB_INIT_LOCK| ] 770 # ; 771 772 my $got = BerkeleyDB::ParseParameters({ 773 Home => undef, 774 Flags => 0, 775 Config => undef, 776 }, @_) ; 777 778 if (defined $got->{Config}) { 779 croak("Config parameter must be a hash reference") 780 if ! ref $got->{Config} eq 'HASH' ; 781 782 @BerkeleyDB::a = () ; 783 my $k = "" ; my $v = "" ; 784 while (($k, $v) = each %{$got->{Config}}) { 785 push @BerkeleyDB::a, "$k\t$v" ; 786 } 787 788 $got->{"Config"} = pack("p*", @BerkeleyDB::a, undef) 789 if @BerkeleyDB::a ; 790 } 791 792 return _env_remove($got) ; 793} 794 795sub db_remove 796{ 797 my $got = BerkeleyDB::ParseParameters( 798 { 799 Filename => undef, 800 Subname => undef, 801 Flags => 0, 802 Env => undef, 803 Txn => undef, 804 }, @_) ; 805 806 croak("Must specify a filename") 807 if ! defined $got->{Filename} ; 808 809 croak("Env not of type BerkeleyDB::Env") 810 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 811 812 return _db_remove($got); 813} 814 815sub db_rename 816{ 817 my $got = BerkeleyDB::ParseParameters( 818 { 819 Filename => undef, 820 Subname => undef, 821 Newname => undef, 822 Flags => 0, 823 Env => undef, 824 Txn => undef, 825 }, @_) ; 826 827 croak("Env not of type BerkeleyDB::Env") 828 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 829 830 croak("Must specify a filename") 831 if ! defined $got->{Filename} ; 832 833 #croak("Must specify a Subname") 834 #if ! defined $got->{Subname} ; 835 836 croak("Must specify a Newname") 837 if ! defined $got->{Newname} ; 838 839 return _db_rename($got); 840} 841 842sub db_verify 843{ 844 my $got = BerkeleyDB::ParseParameters( 845 { 846 Filename => undef, 847 Subname => undef, 848 Outfile => undef, 849 Flags => 0, 850 Env => undef, 851 }, @_) ; 852 853 croak("Env not of type BerkeleyDB::Env") 854 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 855 856 croak("Must specify a filename") 857 if ! defined $got->{Filename} ; 858 859 return _db_verify($got); 860} 861 862package BerkeleyDB::Env ; 863 864use UNIVERSAL ; 865use Carp ; 866use IO::File; 867use vars qw( %valid_config_keys ) ; 868 869sub isaFilehandle 870{ 871 my $fh = shift ; 872 873 return ((UNIVERSAL::isa($fh,'GLOB') or UNIVERSAL::isa(\$fh,'GLOB')) and defined fileno($fh) ) 874 875} 876 877%valid_config_keys = map { $_, 1 } qw( DB_DATA_DIR DB_LOG_DIR DB_TEMP_DIR 878DB_TMP_DIR ) ; 879 880sub new 881{ 882 # Usage: 883 # 884 # $env = new BerkeleyDB::Env 885 # [ -Home => $path, ] 886 # [ -Mode => mode, ] 887 # [ -Config => { name => value, name => value } 888 # [ -ErrFile => filename, ] 889 # [ -ErrPrefix => "string", ] 890 # [ -Flags => DB_INIT_LOCK| ] 891 # [ -Set_Flags => $flags,] 892 # [ -Cachesize => number ] 893 # [ -LockDetect => ] 894 # [ -Verbose => boolean ] 895 # [ -Encrypt => { Password => string, Flags => value} 896 # 897 # ; 898 899 my $pkg = shift ; 900 my $got = BerkeleyDB::ParseParameters({ 901 Home => undef, 902 Server => undef, 903 Mode => 0666, 904 ErrFile => undef, 905 MsgFile => undef, 906 ErrPrefix => undef, 907 Flags => 0, 908 SetFlags => 0, 909 Cachesize => 0, 910 LockDetect => 0, 911 TxMax => 0, 912 LogConfig => 0, 913 MaxLockers => 0, 914 MaxLocks => 0, 915 MaxObjects => 0, 916 Verbose => 0, 917 Config => undef, 918 Encrypt => undef, 919 SharedMemKey => undef, 920 Set_Lk_Exclusive => undef, 921 ThreadCount => 0, 922 }, @_) ; 923 924 my $errfile = $got->{ErrFile} ; 925 if (defined $got->{ErrFile}) { 926 if (!isaFilehandle($got->{ErrFile})) { 927 my $handle = new IO::File ">$got->{ErrFile}" 928 or croak "Cannot open file $got->{ErrFile}: $!\n" ; 929 $errfile = $got->{ErrFile} = $handle ; 930 } 931 } 932 933 if (defined $got->{MsgFile}) { 934 my $msgfile = $got->{MsgFile} ; 935 if (!isaFilehandle($msgfile)) { 936 my $handle = new IO::File ">$msgfile" 937 or croak "Cannot open file $msgfile: $!\n" ; 938 $got->{MsgFile} = $handle ; 939 } 940 } 941 942 my %config ; 943 if (defined $got->{Config}) { 944 croak("Config parameter must be a hash reference") 945 if ! ref $got->{Config} eq 'HASH' ; 946 947 %config = %{ $got->{Config} } ; 948 @BerkeleyDB::a = () ; 949 my $k = "" ; my $v = "" ; 950 while (($k, $v) = each %config) { 951 if ($BerkeleyDB::db_version >= 3.1 && ! $valid_config_keys{$k} ){ 952 $BerkeleyDB::Error = "illegal name-value pair: $k $v\n" ; 953 croak $BerkeleyDB::Error ; 954 } 955 push @BerkeleyDB::a, "$k\t$v" ; 956 $got->{$k} = $v; 957 } 958 959 $got->{"Config"} = pack("p*", @BerkeleyDB::a, undef) 960 if @BerkeleyDB::a ; 961 } 962 963 BerkeleyDB::parseEncrypt($got); 964 965 my ($addr) = _db_appinit($pkg, $got, $errfile); 966 my $obj ; 967 $obj = bless [$addr] , $pkg if $addr ; 968# if ($obj && $BerkeleyDB::db_version >= 3.1 && keys %config) { 969# my ($k, $v); 970# while (($k, $v) = each %config) { 971# if ($k eq 'DB_DATA_DIR') 972# { $obj->set_data_dir($v) } 973# elsif ($k eq 'DB_LOG_DIR') 974# { $obj->set_lg_dir($v) } 975# elsif ($k eq 'DB_TEMP_DIR' || $k eq 'DB_TMP_DIR') 976# { $obj->set_tmp_dir($v) } 977# else { 978# $BerkeleyDB::Error = "illegal name-value pair: $k $v\n" ; 979# croak $BerkeleyDB::Error 980# } 981# } 982# } 983 return $obj ; 984} 985 986 987sub TxnMgr 988{ 989 my $env = shift ; 990 my ($addr) = $env->_TxnMgr() ; 991 my $obj ; 992 $obj = bless [$addr, $env] , "BerkeleyDB::TxnMgr" if $addr ; 993 return $obj ; 994} 995 996sub txn_begin 997{ 998 my $env = shift ; 999 my ($addr) = $env->_txn_begin(@_) ; 1000 my $obj ; 1001 $obj = bless [$addr, $env] , "BerkeleyDB::Txn" if $addr ; 1002 return $obj ; 1003} 1004 1005sub DESTROY 1006{ 1007 my $self = shift ; 1008 $self->_DESTROY() ; 1009} 1010 1011sub STORABLE_freeze 1012{ 1013 my $type = ref shift; 1014 croak "Cannot freeze $type object\n"; 1015} 1016 1017sub STORABLE_thaw 1018{ 1019 my $type = ref shift; 1020 croak "Cannot thaw $type object\n"; 1021} 1022 1023package BerkeleyDB::Hash ; 1024 1025use vars qw(@ISA) ; 1026@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ; 1027use UNIVERSAL ; 1028use Carp ; 1029 1030sub new 1031{ 1032 my $self = shift ; 1033 my $got = BerkeleyDB::ParseParameters( 1034 { 1035 # Generic Stuff 1036 Filename => undef, 1037 Subname => undef, 1038 #Flags => BerkeleyDB::DB_CREATE(), 1039 Flags => 0, 1040 Property => 0, 1041 Mode => 0666, 1042 Cachesize => 0, 1043 Lorder => 0, 1044 Pagesize => 0, 1045 Env => undef, 1046 #Tie => undef, 1047 Txn => undef, 1048 Encrypt => undef, 1049 1050 # Hash specific 1051 Ffactor => 0, 1052 Nelem => 0, 1053 Hash => undef, 1054 DupCompare => undef, 1055 1056 # BerkeleyDB specific 1057 ReadKey => undef, 1058 WriteKey => undef, 1059 ReadValue => undef, 1060 WriteValue => undef, 1061 }, @_) ; 1062 1063 croak("Env not of type BerkeleyDB::Env") 1064 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1065 1066 croak("Txn not of type BerkeleyDB::Txn") 1067 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1068 1069 croak("-Tie needs a reference to a hash") 1070 if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; 1071 1072 BerkeleyDB::parseEncrypt($got); 1073 1074 my ($addr) = _db_open_hash($self, $got); 1075 my $obj ; 1076 if ($addr) { 1077 $obj = bless [$addr] , $self ; 1078 push @{ $obj }, $got->{Env} if $got->{Env} ; 1079 $obj->Txn($got->{Txn}) 1080 if $got->{Txn} ; 1081 } 1082 return $obj ; 1083} 1084 1085*TIEHASH = \&new ; 1086 1087 1088package BerkeleyDB::Btree ; 1089 1090use vars qw(@ISA) ; 1091@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ; 1092use UNIVERSAL ; 1093use Carp ; 1094 1095sub new 1096{ 1097 my $self = shift ; 1098 my $got = BerkeleyDB::ParseParameters( 1099 { 1100 # Generic Stuff 1101 Filename => undef, 1102 Subname => undef, 1103 #Flags => BerkeleyDB::DB_CREATE(), 1104 Flags => 0, 1105 Property => 0, 1106 Mode => 0666, 1107 Cachesize => 0, 1108 Lorder => 0, 1109 Pagesize => 0, 1110 Env => undef, 1111 #Tie => undef, 1112 Txn => undef, 1113 Encrypt => undef, 1114 1115 # Btree specific 1116 Minkey => 0, 1117 Compare => undef, 1118 DupCompare => undef, 1119 Prefix => undef, 1120 set_bt_compress => undef, 1121 }, @_) ; 1122 1123 croak("Env not of type BerkeleyDB::Env") 1124 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1125 1126 croak("Txn not of type BerkeleyDB::Txn") 1127 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1128 1129 croak("-Tie needs a reference to a hash") 1130 if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; 1131 1132# if (defined $got->{set_bt_compress} ) 1133# { 1134# 1135# croak("-set_bt_compress needs a reference to a 2-element array") 1136# if $got->{set_bt_compress} !~ /ARRAY/ || 1137# 1138# croak("-set_bt_compress needs a reference to a 2-element array") 1139# if $got->{set_bt_compress} !~ /ARRAY/ || 1140# @{ $got->{set_bt_compress} } != 2; 1141# 1142# $got->{"_btcompress1"} = $got->{set_bt_compress}[0] 1143# if defined $got->{set_bt_compress}[0]; 1144# 1145# $got->{"_btcompress2"} = $got->{set_bt_compress}[1] 1146# if defined $got->{set_bt_compress}[1]; 1147# } 1148 1149 BerkeleyDB::parseEncrypt($got); 1150 1151 my ($addr) = _db_open_btree($self, $got); 1152 my $obj ; 1153 if ($addr) { 1154 $obj = bless [$addr] , $self ; 1155 push @{ $obj }, $got->{Env} if $got->{Env} ; 1156 $obj->Txn($got->{Txn}) 1157 if $got->{Txn} ; 1158 } 1159 return $obj ; 1160} 1161 1162*BerkeleyDB::Btree::TIEHASH = \&BerkeleyDB::Btree::new ; 1163 1164package BerkeleyDB::Heap ; 1165 1166use vars qw(@ISA) ; 1167@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ; 1168use UNIVERSAL ; 1169use Carp ; 1170 1171sub new 1172{ 1173 my $self = shift ; 1174 my $got = BerkeleyDB::ParseParameters( 1175 { 1176 # Generic Stuff 1177 Filename => undef, 1178 Subname => undef, 1179 #Flags => BerkeleyDB::DB_CREATE(), 1180 Flags => 0, 1181 Property => 0, 1182 Mode => 0666, 1183 Cachesize => 0, 1184 Lorder => 0, 1185 Pagesize => 0, 1186 Env => undef, 1187 Txn => undef, 1188 Encrypt => undef, 1189 1190 # Heap specific 1191 HeapSize => undef, 1192 HeapSizeGb => undef, 1193 }, @_) ; 1194 1195 croak("Env not of type BerkeleyDB::Env") 1196 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1197 1198 croak("Txn not of type BerkeleyDB::Txn") 1199 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1200 1201# if (defined $got->{HeapSize} ) 1202# { 1203# 1204# croak("-HeapSize needs a reference to a 2-element array") 1205# if $got->{HeapSize} !~ /ARRAY/ || 1206# 1207# croak("-HeapSize needs a reference to a 2-element array") 1208# if $got->{HeapSize} !~ /ARRAY/ || 1209# @{ $got->{set_bt_compress} } != 2; 1210# 1211# $got->{"HeapSize"} = $got->{HeapSize}[0] 1212# if defined $got->{HeapSize}[0]; 1213# 1214# $got->{"HeapSize"} = $got->{HeapSize}[1] 1215# if defined $got->{HeapSize}[1]; 1216# } 1217 1218 BerkeleyDB::parseEncrypt($got); 1219 1220 my ($addr) = _db_open_heap($self, $got); 1221 my $obj ; 1222 if ($addr) { 1223 $obj = bless [$addr] , $self ; 1224 push @{ $obj }, $got->{Env} if $got->{Env} ; 1225 $obj->Txn($got->{Txn}) 1226 if $got->{Txn} ; 1227 } 1228 return $obj ; 1229} 1230 1231sub TIEHASH 1232{ 1233 die "Tied Hash interface not supported with BerkeleyDB::Heap\n" ; 1234} 1235 1236 1237package BerkeleyDB::Recno ; 1238 1239use vars qw(@ISA) ; 1240@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ; 1241use UNIVERSAL ; 1242use Carp ; 1243 1244sub new 1245{ 1246 my $self = shift ; 1247 my $got = BerkeleyDB::ParseParameters( 1248 { 1249 # Generic Stuff 1250 Filename => undef, 1251 Subname => undef, 1252 #Flags => BerkeleyDB::DB_CREATE(), 1253 Flags => 0, 1254 Property => 0, 1255 Mode => 0666, 1256 Cachesize => 0, 1257 Lorder => 0, 1258 Pagesize => 0, 1259 Env => undef, 1260 #Tie => undef, 1261 Txn => undef, 1262 Encrypt => undef, 1263 1264 # Recno specific 1265 Delim => undef, 1266 Len => undef, 1267 Pad => undef, 1268 Source => undef, 1269 ArrayBase => 1, # lowest index in array 1270 }, @_) ; 1271 1272 croak("Env not of type BerkeleyDB::Env") 1273 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1274 1275 croak("Txn not of type BerkeleyDB::Txn") 1276 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1277 1278 croak("Tie needs a reference to an array") 1279 if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ; 1280 1281 croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}") 1282 if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ; 1283 1284 1285 BerkeleyDB::parseEncrypt($got); 1286 1287 $got->{Fname} = $got->{Filename} if defined $got->{Filename} ; 1288 1289 my ($addr) = _db_open_recno($self, $got); 1290 my $obj ; 1291 if ($addr) { 1292 $obj = bless [$addr] , $self ; 1293 push @{ $obj }, $got->{Env} if $got->{Env} ; 1294 $obj->Txn($got->{Txn}) 1295 if $got->{Txn} ; 1296 } 1297 return $obj ; 1298} 1299 1300*BerkeleyDB::Recno::TIEARRAY = \&BerkeleyDB::Recno::new ; 1301*BerkeleyDB::Recno::db_stat = \&BerkeleyDB::Btree::db_stat ; 1302 1303package BerkeleyDB::Queue ; 1304 1305use vars qw(@ISA) ; 1306@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ; 1307use UNIVERSAL ; 1308use Carp ; 1309 1310sub new 1311{ 1312 my $self = shift ; 1313 my $got = BerkeleyDB::ParseParameters( 1314 { 1315 # Generic Stuff 1316 Filename => undef, 1317 Subname => undef, 1318 #Flags => BerkeleyDB::DB_CREATE(), 1319 Flags => 0, 1320 Property => 0, 1321 Mode => 0666, 1322 Cachesize => 0, 1323 Lorder => 0, 1324 Pagesize => 0, 1325 Env => undef, 1326 #Tie => undef, 1327 Txn => undef, 1328 Encrypt => undef, 1329 1330 # Queue specific 1331 Len => undef, 1332 Pad => undef, 1333 ArrayBase => 1, # lowest index in array 1334 ExtentSize => undef, 1335 }, @_) ; 1336 1337 croak("Env not of type BerkeleyDB::Env") 1338 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1339 1340 croak("Txn not of type BerkeleyDB::Txn") 1341 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1342 1343 croak("Tie needs a reference to an array") 1344 if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ; 1345 1346 croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}") 1347 if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ; 1348 1349 BerkeleyDB::parseEncrypt($got); 1350 1351 $got->{Fname} = $got->{Filename} if defined $got->{Filename} ; 1352 1353 my ($addr) = _db_open_queue($self, $got); 1354 my $obj ; 1355 if ($addr) { 1356 $obj = bless [$addr] , $self ; 1357 push @{ $obj }, $got->{Env} if $got->{Env} ; 1358 $obj->Txn($got->{Txn}) 1359 if $got->{Txn} ; 1360 } 1361 return $obj ; 1362} 1363 1364*BerkeleyDB::Queue::TIEARRAY = \&BerkeleyDB::Queue::new ; 1365 1366sub UNSHIFT 1367{ 1368 my $self = shift; 1369 croak "unshift is unsupported with Queue databases"; 1370} 1371 1372## package BerkeleyDB::Text ; 1373## 1374## use vars qw(@ISA) ; 1375## @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ; 1376## use UNIVERSAL ; 1377## use Carp ; 1378## 1379## sub new 1380## { 1381## my $self = shift ; 1382## my $got = BerkeleyDB::ParseParameters( 1383## { 1384## # Generic Stuff 1385## Filename => undef, 1386## #Flags => BerkeleyDB::DB_CREATE(), 1387## Flags => 0, 1388## Property => 0, 1389## Mode => 0666, 1390## Cachesize => 0, 1391## Lorder => 0, 1392## Pagesize => 0, 1393## Env => undef, 1394## #Tie => undef, 1395## Txn => undef, 1396## 1397## # Recno specific 1398## Delim => undef, 1399## Len => undef, 1400## Pad => undef, 1401## Btree => undef, 1402## }, @_) ; 1403## 1404## croak("Env not of type BerkeleyDB::Env") 1405## if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env'); 1406## 1407## croak("Txn not of type BerkeleyDB::Txn") 1408## if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn'); 1409## 1410## croak("-Tie needs a reference to an array") 1411## if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ; 1412## 1413## # rearange for recno 1414## $got->{Source} = $got->{Filename} if defined $got->{Filename} ; 1415## delete $got->{Filename} ; 1416## $got->{Fname} = $got->{Btree} if defined $got->{Btree} ; 1417## return BerkeleyDB::Recno::_db_open_recno($self, $got); 1418## } 1419## 1420## *BerkeleyDB::Text::TIEARRAY = \&BerkeleyDB::Text::new ; 1421## *BerkeleyDB::Text::db_stat = \&BerkeleyDB::Btree::db_stat ; 1422 1423package BerkeleyDB::Unknown ; 1424 1425use vars qw(@ISA) ; 1426@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ; 1427use UNIVERSAL ; 1428use Carp ; 1429 1430sub new 1431{ 1432 my $self = shift ; 1433 my $got = BerkeleyDB::ParseParameters( 1434 { 1435 # Generic Stuff 1436 Filename => undef, 1437 Subname => undef, 1438 #Flags => BerkeleyDB::DB_CREATE(), 1439 Flags => 0, 1440 Property => 0, 1441 Mode => 0666, 1442 Cachesize => 0, 1443 Lorder => 0, 1444 Pagesize => 0, 1445 Env => undef, 1446 #Tie => undef, 1447 Txn => undef, 1448 Encrypt => undef, 1449 1450 }, @_) ; 1451 1452 croak("Env not of type BerkeleyDB::Env") 1453 if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env'); 1454 1455 croak("Txn not of type BerkeleyDB::Txn") 1456 if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn'); 1457 1458 croak("-Tie needs a reference to a hash") 1459 if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; 1460 1461 BerkeleyDB::parseEncrypt($got); 1462 1463 my ($addr, $type) = _db_open_unknown($got); 1464 my $obj ; 1465 if ($addr) { 1466 $obj = bless [$addr], "BerkeleyDB::$type" ; 1467 push @{ $obj }, $got->{Env} if $got->{Env} ; 1468 $obj->Txn($got->{Txn}) 1469 if $got->{Txn} ; 1470 } 1471 return $obj ; 1472} 1473 1474 1475package BerkeleyDB::_tiedHash ; 1476 1477use Carp ; 1478 1479#sub TIEHASH 1480#{ 1481# my $self = shift ; 1482# my $db_object = shift ; 1483# 1484#print "Tiehash REF=[$self] [" . (ref $self) . "]\n" ; 1485# 1486# return bless { Obj => $db_object}, $self ; 1487#} 1488 1489sub Tie 1490{ 1491 # Usage: 1492 # 1493 # $db->Tie \%hash ; 1494 # 1495 1496 my $self = shift ; 1497 1498 #print "Tie method REF=[$self] [" . (ref $self) . "]\n" ; 1499 1500 croak("usage \$x->Tie \\%hash\n") unless @_ ; 1501 my $ref = shift ; 1502 1503 croak("Tie needs a reference to a hash") 1504 if defined $ref and $ref !~ /HASH/ ; 1505 1506 #tie %{ $ref }, ref($self), $self ; 1507 tie %{ $ref }, "BerkeleyDB::_tiedHash", $self ; 1508 return undef ; 1509} 1510 1511 1512sub TIEHASH 1513{ 1514 my $self = shift ; 1515 my $db_object = shift ; 1516 #return bless $db_object, 'BerkeleyDB::Common' ; 1517 return $db_object ; 1518} 1519 1520sub STORE 1521{ 1522 my $self = shift ; 1523 my $key = shift ; 1524 my $value = shift ; 1525 1526 $self->db_put($key, $value) ; 1527} 1528 1529sub FETCH 1530{ 1531 my $self = shift ; 1532 my $key = shift ; 1533 my $value = undef ; 1534 $self->db_get($key, $value) ; 1535 1536 return $value ; 1537} 1538 1539sub EXISTS 1540{ 1541 my $self = shift ; 1542 my $key = shift ; 1543 my $value = undef ; 1544 $self->db_get($key, $value) == 0 ; 1545} 1546 1547sub DELETE 1548{ 1549 my $self = shift ; 1550 my $key = shift ; 1551 $self->db_del($key) ; 1552} 1553 1554sub CLEAR_old 1555{ 1556 my $self = shift ; 1557 my ($key, $value) = (0, 0) ; 1558 my $cursor = $self->_db_write_cursor() ; 1559 while ($cursor->c_get($key, $value, BerkeleyDB::DB_PREV()) == 0) 1560 { $cursor->c_del() } 1561} 1562 1563sub CLEAR_new 1564{ 1565 my $self = shift ; 1566 $self->truncate(my $count); 1567} 1568 1569*CLEAR = $BerkeleyDB::db_version < 4 ? \&CLEAR_old : \&CLEAR_new ; 1570 1571#sub DESTROY 1572#{ 1573# my $self = shift ; 1574# print "BerkeleyDB::_tieHash::DESTROY\n" ; 1575# $self->{Cursor}->c_close() if $self->{Cursor} ; 1576#} 1577 1578package BerkeleyDB::_tiedArray ; 1579 1580use Carp ; 1581 1582sub Tie 1583{ 1584 # Usage: 1585 # 1586 # $db->Tie \@array ; 1587 # 1588 1589 my $self = shift ; 1590 1591 #print "Tie method REF=[$self] [" . (ref $self) . "]\n" ; 1592 1593 croak("usage \$x->Tie \\%hash\n") unless @_ ; 1594 my $ref = shift ; 1595 1596 croak("Tie needs a reference to an array") 1597 if defined $ref and $ref !~ /ARRAY/ ; 1598 1599 #tie %{ $ref }, ref($self), $self ; 1600 tie @{ $ref }, "BerkeleyDB::_tiedArray", $self ; 1601 return undef ; 1602} 1603 1604 1605#sub TIEARRAY 1606#{ 1607# my $self = shift ; 1608# my $db_object = shift ; 1609# 1610#print "Tiearray REF=[$self] [" . (ref $self) . "]\n" ; 1611# 1612# return bless { Obj => $db_object}, $self ; 1613#} 1614 1615sub TIEARRAY 1616{ 1617 my $self = shift ; 1618 my $db_object = shift ; 1619 #return bless $db_object, 'BerkeleyDB::Common' ; 1620 return $db_object ; 1621} 1622 1623sub STORE 1624{ 1625 my $self = shift ; 1626 my $key = shift ; 1627 my $value = shift ; 1628 1629 $self->db_put($key, $value) ; 1630} 1631 1632sub FETCH 1633{ 1634 my $self = shift ; 1635 my $key = shift ; 1636 my $value = undef ; 1637 $self->db_get($key, $value) ; 1638 1639 return $value ; 1640} 1641 1642*CLEAR = \&BerkeleyDB::_tiedHash::CLEAR ; 1643*FIRSTKEY = \&BerkeleyDB::_tiedHash::FIRSTKEY ; 1644*NEXTKEY = \&BerkeleyDB::_tiedHash::NEXTKEY ; 1645 1646sub EXTEND {} # don't do anything with EXTEND 1647 1648 1649sub SHIFT 1650{ 1651 my $self = shift; 1652 my ($key, $value) = (0, 0) ; 1653 my $cursor = $self->_db_write_cursor() ; 1654 return undef if $cursor->c_get($key, $value, BerkeleyDB::DB_FIRST()) != 0 ; 1655 return undef if $cursor->c_del() != 0 ; 1656 1657 return $value ; 1658} 1659 1660 1661sub UNSHIFT 1662{ 1663 my $self = shift; 1664 if (@_) 1665 { 1666 my ($key, $value) = (0, 0) ; 1667 my $cursor = $self->_db_write_cursor() ; 1668 my $status = $cursor->c_get($key, $value, BerkeleyDB::DB_FIRST()) ; 1669 if ($status == 0) 1670 { 1671 foreach $value (reverse @_) 1672 { 1673 $key = 0 ; 1674 $cursor->c_put($key, $value, BerkeleyDB::DB_BEFORE()) ; 1675 } 1676 } 1677 elsif ($status == BerkeleyDB::DB_NOTFOUND()) 1678 { 1679 $key = 0 ; 1680 foreach $value (@_) 1681 { 1682 $self->db_put($key++, $value) ; 1683 } 1684 } 1685 } 1686} 1687 1688sub PUSH 1689{ 1690 my $self = shift; 1691 if (@_) 1692 { 1693 my ($key, $value) = (-1, 0) ; 1694 my $cursor = $self->_db_write_cursor() ; 1695 my $status = $cursor->c_get($key, $value, BerkeleyDB::DB_LAST()) ; 1696 if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND()) 1697 { 1698 $key = -1 if $status != 0 and $self->type != BerkeleyDB::DB_RECNO() ; 1699 foreach $value (@_) 1700 { 1701 ++ $key ; 1702 $status = $self->db_put($key, $value) ; 1703 } 1704 } 1705 1706# can use this when DB_APPEND is fixed. 1707# foreach $value (@_) 1708# { 1709# my $status = $cursor->c_put($key, $value, BerkeleyDB::DB_AFTER()) ; 1710#print "[$status]\n" ; 1711# } 1712 } 1713} 1714 1715sub POP 1716{ 1717 my $self = shift; 1718 my ($key, $value) = (0, 0) ; 1719 my $cursor = $self->_db_write_cursor() ; 1720 return undef if $cursor->c_get($key, $value, BerkeleyDB::DB_LAST()) != 0 ; 1721 return undef if $cursor->c_del() != 0 ; 1722 1723 return $value ; 1724} 1725 1726sub SPLICE 1727{ 1728 my $self = shift; 1729 croak "SPLICE is not implemented yet" ; 1730} 1731 1732*shift = \&SHIFT ; 1733*unshift = \&UNSHIFT ; 1734*push = \&PUSH ; 1735*pop = \&POP ; 1736*clear = \&CLEAR ; 1737*length = \&FETCHSIZE ; 1738 1739sub STORESIZE 1740{ 1741 croak "STORESIZE is not implemented yet" ; 1742#print "STORESIZE @_\n" ; 1743# my $self = shift; 1744# my $length = shift ; 1745# my $current_length = $self->FETCHSIZE() ; 1746#print "length is $current_length\n"; 1747# 1748# if ($length < $current_length) { 1749#print "Make smaller $length < $current_length\n" ; 1750# my $key ; 1751# for ($key = $current_length - 1 ; $key >= $length ; -- $key) 1752# { $self->db_del($key) } 1753# } 1754# elsif ($length > $current_length) { 1755#print "Make larger $length > $current_length\n" ; 1756# $self->db_put($length-1, "") ; 1757# } 1758# else { print "stay the same\n" } 1759 1760} 1761 1762 1763 1764#sub DESTROY 1765#{ 1766# my $self = shift ; 1767# print "BerkeleyDB::_tieArray::DESTROY\n" ; 1768#} 1769 1770 1771package BerkeleyDB::Common ; 1772 1773 1774use Carp ; 1775 1776 1777sub STORABLE_freeze 1778{ 1779 my $type = ref shift; 1780 croak "Cannot freeze $type object\n"; 1781} 1782 1783sub STORABLE_thaw 1784{ 1785 my $type = ref shift; 1786 croak "Cannot thaw $type object\n"; 1787} 1788 1789sub DESTROY 1790{ 1791 my $self = shift ; 1792 $self->_DESTROY() ; 1793} 1794sub Env 1795{ 1796 my $self = shift ; 1797 $self->[1] ; 1798} 1799 1800sub Txn 1801{ 1802 my $self = shift ; 1803 my $txn = shift ; 1804 #print "BerkeleyDB::Common::Txn db [$self] txn [$txn]\n" ; 1805 if ($txn) { 1806 $self->_Txn($txn) ; 1807 push @{ $txn }, $self ; 1808 } 1809 else { 1810 $self->_Txn() ; 1811 } 1812 #print "end BerkeleyDB::Common::Txn \n"; 1813} 1814 1815 1816sub get_dup 1817{ 1818 croak "Usage: \$db->get_dup(key [,flag])\n" 1819 unless @_ == 2 or @_ == 3 ; 1820 1821 my $db = shift ; 1822 my $key = shift ; 1823 my $flag = shift ; 1824 my $value = 0 ; 1825 my $origkey = $key ; 1826 my $wantarray = wantarray ; 1827 my %values = () ; 1828 my @values = () ; 1829 my $counter = 0 ; 1830 my $status = 0 ; 1831 my $cursor = $db->db_cursor() ; 1832 1833 # iterate through the database until either EOF ($status == 0) 1834 # or a different key is encountered ($key ne $origkey). 1835 for ($status = $cursor->c_get($key, $value, BerkeleyDB::DB_SET()) ; 1836 $status == 0 and $key eq $origkey ; 1837 $status = $cursor->c_get($key, $value, BerkeleyDB::DB_NEXT()) ) { 1838 # save the value or count number of matches 1839 if ($wantarray) { 1840 if ($flag) 1841 { ++ $values{$value} } 1842 else 1843 { push (@values, $value) } 1844 } 1845 else 1846 { ++ $counter } 1847 1848 } 1849 1850 return ($wantarray ? ($flag ? %values : @values) : $counter) ; 1851} 1852 1853sub db_cursor 1854{ 1855 my $db = shift ; 1856 my ($addr) = $db->_db_cursor(@_) ; 1857 my $obj ; 1858 $obj = bless [$addr, $db] , "BerkeleyDB::Cursor" if $addr ; 1859 return $obj ; 1860} 1861 1862sub _db_write_cursor 1863{ 1864 my $db = shift ; 1865 my ($addr) = $db->__db_write_cursor(@_) ; 1866 my $obj ; 1867 $obj = bless [$addr, $db] , "BerkeleyDB::Cursor" if $addr ; 1868 return $obj ; 1869} 1870 1871sub db_join 1872{ 1873 croak 'Usage: $db->BerkeleyDB::db_join([cursors], flags=0)' 1874 if @_ < 2 || @_ > 3 ; 1875 my $db = shift ; 1876 croak 'db_join: first parameter is not an array reference' 1877 if ! ref $_[0] || ref $_[0] ne 'ARRAY'; 1878 my ($addr) = $db->_db_join(@_) ; 1879 my $obj ; 1880 $obj = bless [$addr, $db, $_[0]] , "BerkeleyDB::Cursor" if $addr ; 1881 return $obj ; 1882} 1883 1884package BerkeleyDB::Cursor ; 1885 1886sub c_close 1887{ 1888 my $cursor = shift ; 1889 $cursor->[1] = "" ; 1890 return $cursor->_c_close() ; 1891} 1892 1893sub c_dup 1894{ 1895 my $cursor = shift ; 1896 my ($addr) = $cursor->_c_dup(@_) ; 1897 my $obj ; 1898 $obj = bless [$addr, $cursor->[1]] , "BerkeleyDB::Cursor" if $addr ; 1899 return $obj ; 1900} 1901 1902sub DESTROY 1903{ 1904 my $self = shift ; 1905 $self->_DESTROY() ; 1906} 1907 1908package BerkeleyDB::TxnMgr ; 1909 1910sub DESTROY 1911{ 1912 my $self = shift ; 1913 $self->_DESTROY() ; 1914} 1915 1916sub txn_begin 1917{ 1918 my $txnmgr = shift ; 1919 my ($addr) = $txnmgr->_txn_begin(@_) ; 1920 my $obj ; 1921 $obj = bless [$addr, $txnmgr] , "BerkeleyDB::Txn" if $addr ; 1922 return $obj ; 1923} 1924 1925package BerkeleyDB::Txn ; 1926 1927sub Txn 1928{ 1929 my $self = shift ; 1930 my $db ; 1931 # keep a reference to each db in the txn object 1932 foreach $db (@_) { 1933 $db->_Txn($self) ; 1934 push @{ $self}, $db ; 1935 } 1936} 1937 1938sub txn_commit 1939{ 1940 my $self = shift ; 1941 $self->disassociate() ; 1942 my $status = $self->_txn_commit() ; 1943 return $status ; 1944} 1945 1946sub txn_abort 1947{ 1948 my $self = shift ; 1949 $self->disassociate() ; 1950 my $status = $self->_txn_abort() ; 1951 return $status ; 1952} 1953 1954sub disassociate 1955{ 1956 my $self = shift ; 1957 my $db ; 1958 while ( @{ $self } > 2) { 1959 $db = pop @{ $self } ; 1960 $db->Txn() ; 1961 } 1962 #print "end disassociate\n" ; 1963} 1964 1965 1966sub DESTROY 1967{ 1968 my $self = shift ; 1969 1970 $self->disassociate() ; 1971 # first close the close the transaction 1972 $self->_DESTROY() ; 1973} 1974 1975package BerkeleyDB::CDS::Lock; 1976 1977use vars qw(%Object %Count); 1978use Carp; 1979 1980sub BerkeleyDB::Common::cds_lock 1981{ 1982 my $db = shift ; 1983 1984 # fatal error if database not opened in CDS mode 1985 croak("CDS not enabled for this database\n") 1986 if ! $db->cds_enabled(); 1987 1988 if ( ! defined $Object{"$db"}) 1989 { 1990 $Object{"$db"} = $db->_db_write_cursor() 1991 || return undef ; 1992 } 1993 1994 ++ $Count{"$db"} ; 1995 1996 return bless [$db, 1], "BerkeleyDB::CDS::Lock" ; 1997} 1998 1999sub cds_unlock 2000{ 2001 my $self = shift ; 2002 my $db = $self->[0] ; 2003 2004 if ($self->[1]) 2005 { 2006 $self->[1] = 0 ; 2007 -- $Count{"$db"} if $Count{"$db"} > 0 ; 2008 2009 if ($Count{"$db"} == 0) 2010 { 2011 $Object{"$db"}->c_close() ; 2012 undef $Object{"$db"}; 2013 } 2014 2015 return 1 ; 2016 } 2017 2018 return undef ; 2019} 2020 2021sub DESTROY 2022{ 2023 my $self = shift ; 2024 $self->cds_unlock() ; 2025} 2026 2027package BerkeleyDB::Term ; 2028 2029END 2030{ 2031 close_everything() ; 2032} 2033 2034 2035package BerkeleyDB ; 2036 2037 2038 2039# Autoload methods go after =cut, and are processed by the autosplit program. 2040 20411; 2042__END__ 2043 2044 2045 2046