lang/perl/BerkeleyDB/BerkeleyDB.pm

   1
   2 package 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
  13 BEGIN { require 5.005 }
  14
  15 use strict;
  16 use Carp;
  17 use vars qw($VERSION @ISA @EXPORT $AUTOLOAD
  18                 $use_XSLoader);
  19
  20 $VERSION = '0.50';
  21
  22 require Exporter;
  23 #require DynaLoader;
  24 require AutoLoader;
  25
  26 BEGIN {
  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
 673 sub 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;
 684 if ($use_XSLoader)
 685   { XSLoader::load("BerkeleyDB", $VERSION)}
 686 else
 687   { bootstrap BerkeleyDB $VERSION }
 688
 689 # Preloaded methods go here.
 690
 691
 692 sub 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
 736 sub 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
 760 use UNIVERSAL ;
 761
 762 sub 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
 795 sub 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
 815 sub 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
 842 sub 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
 862 package BerkeleyDB::Env ;
 863
 864 use UNIVERSAL ;
 865 use Carp ;
 866 use IO::File;
 867 use vars qw( %valid_config_keys ) ;
 868
 869 sub 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
 878 DB_TMP_DIR ) ;
 879
 880 sub 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
 987 sub 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
 996 sub 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
1005 sub DESTROY
1006 {
1007     my $self = shift ;
1008     $self->_DESTROY() ;
1009 }
1010
1011 sub STORABLE_freeze
1012 {
1013     my $type = ref shift;
1014     croak "Cannot freeze $type object\n";
1015 }
1016
1017 sub STORABLE_thaw
1018 {
1019     my $type = ref shift;
1020     croak "Cannot thaw $type object\n";
1021 }
1022
1023 package BerkeleyDB::Hash ;
1024
1025 use vars qw(@ISA) ;
1026 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
1027 use UNIVERSAL ;
1028 use Carp ;
1029
1030 sub 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
1088 package BerkeleyDB::Btree ;
1089
1090 use vars qw(@ISA) ;
1091 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
1092 use UNIVERSAL ;
1093 use Carp ;
1094
1095 sub 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
1164 package BerkeleyDB::Heap ;
1165
1166 use vars qw(@ISA) ;
1167 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
1168 use UNIVERSAL ;
1169 use Carp ;
1170
1171 sub 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
1231 sub TIEHASH
1232 {
1233     die "Tied Hash interface not supported with BerkeleyDB::Heap\n" ;
1234 }
1235
1236
1237 package BerkeleyDB::Recno ;
1238
1239 use vars qw(@ISA) ;
1240 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1241 use UNIVERSAL ;
1242 use Carp ;
1243
1244 sub 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
1303 package BerkeleyDB::Queue ;
1304
1305 use vars qw(@ISA) ;
1306 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1307 use UNIVERSAL ;
1308 use Carp ;
1309
1310 sub 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
1366 sub 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
1423 package BerkeleyDB::Unknown ;
1424
1425 use vars qw(@ISA) ;
1426 @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
1427 use UNIVERSAL ;
1428 use Carp ;
1429
1430 sub 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
1475 package BerkeleyDB::_tiedHash ;
1476
1477 use 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
1489 sub 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
1512 sub TIEHASH
1513 {
1514     my $self = shift ;
1515     my $db_object = shift ;
1516     #return bless $db_object, 'BerkeleyDB::Common' ;
1517     return $db_object ;
1518 }
1519
1520 sub STORE
1521 {
1522     my $self = shift ;
1523     my $key  = shift ;
1524     my $value = shift ;
1525
1526     $self->db_put($key, $value) ;
1527 }
1528
1529 sub 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
1539 sub EXISTS
1540 {
1541     my $self = shift ;
1542     my $key  = shift ;
1543     my $value = undef ;
1544     $self->db_get($key, $value) == 0 ;
1545 }
1546
1547 sub DELETE
1548 {
1549     my $self = shift ;
1550     my $key  = shift ;
1551     $self->db_del($key) ;
1552 }
1553
1554 sub 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
1563 sub 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
1578 package BerkeleyDB::_tiedArray ;
1579
1580 use Carp ;
1581
1582 sub 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
1615 sub TIEARRAY
1616 {
1617     my $self = shift ;
1618     my $db_object = shift ;
1619     #return bless $db_object, 'BerkeleyDB::Common' ;
1620     return $db_object ;
1621 }
1622
1623 sub STORE
1624 {
1625     my $self = shift ;
1626     my $key  = shift ;
1627     my $value = shift ;
1628
1629     $self->db_put($key, $value) ;
1630 }
1631
1632 sub 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
1646 sub EXTEND {} # don't do anything with EXTEND
1647
1648
1649 sub 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
1661 sub 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
1688 sub 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
1715 sub 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
1726 sub 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
1739 sub 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
1771 package BerkeleyDB::Common ;
1772
1773
1774 use Carp ;
1775
1776
1777 sub STORABLE_freeze
1778 {
1779     my $type = ref shift;
1780     croak "Cannot freeze $type object\n";
1781 }
1782
1783 sub STORABLE_thaw
1784 {
1785     my $type = ref shift;
1786     croak "Cannot thaw $type object\n";
1787 }
1788
1789 sub DESTROY
1790 {
1791     my $self = shift ;
1792     $self->_DESTROY() ;
1793 }
1794 sub Env
1795 {
1796     my $self = shift ;
1797     $self->[1] ;
1798 }
1799
1800 sub 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
1816 sub 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
1853 sub 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
1862 sub _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
1871 sub 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
1884 package BerkeleyDB::Cursor ;
1885
1886 sub c_close
1887 {
1888     my $cursor = shift ;
1889     $cursor->[1] = "" ;
1890     return $cursor->_c_close() ;
1891 }
1892
1893 sub 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
1902 sub DESTROY
1903 {
1904     my $self = shift ;
1905     $self->_DESTROY() ;
1906 }
1907
1908 package BerkeleyDB::TxnMgr ;
1909
1910 sub DESTROY
1911 {
1912     my $self = shift ;
1913     $self->_DESTROY() ;
1914 }
1915
1916 sub 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
1925 package BerkeleyDB::Txn ;
1926
1927 sub 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
1938 sub txn_commit
1939 {
1940     my $self = shift ;
1941     $self->disassociate() ;
1942     my $status = $self->_txn_commit() ;
1943     return $status ;
1944 }
1945
1946 sub txn_abort
1947 {
1948     my $self = shift ;
1949     $self->disassociate() ;
1950     my $status = $self->_txn_abort() ;
1951     return $status ;
1952 }
1953
1954 sub 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
1966 sub DESTROY
1967 {
1968     my $self = shift ;
1969
1970     $self->disassociate() ;
1971     # first close the close the transaction
1972     $self->_DESTROY() ;
1973 }
1974
1975 package BerkeleyDB::CDS::Lock;
1976
1977 use vars qw(%Object %Count);
1978 use Carp;
1979
1980 sub 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
1999 sub 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
2021 sub DESTROY
2022 {
2023     my $self = shift ;
2024     $self->cds_unlock() ;
2025 }
2026
2027 package BerkeleyDB::Term ;
2028
2029 END
2030 {
2031     close_everything() ;
2032 }
2033
2034
2035 package BerkeleyDB ;
2036
2037
2038
2039 # Autoload methods go after =cut, and are processed by the autosplit program.
2040
2041 1;
2042 __END__
2043
2044
2045