2143 lines
42 KiB
Perl
2143 lines
42 KiB
Perl
|
|
package BerkeleyDB;
|
|
|
|
|
|
# Copyright (c) 1997-2019 Paul Marquess. All rights reserved.
|
|
# This program is free software; you can redistribute it and/or
|
|
# modify it under the same terms as Perl itself.
|
|
#
|
|
|
|
# The documentation for this module is at the bottom of this file,
|
|
# after the line __END__.
|
|
|
|
use 5.006;
|
|
|
|
use strict;
|
|
use Carp;
|
|
use vars qw($VERSION @ISA @EXPORT $AUTOLOAD
|
|
$use_XSLoader);
|
|
|
|
$VERSION = '0.63';
|
|
|
|
require Exporter;
|
|
|
|
BEGIN {
|
|
$use_XSLoader = 1 ;
|
|
{ local $SIG{__DIE__} ; eval { require XSLoader } ; }
|
|
|
|
if ($@) {
|
|
$use_XSLoader = 0 ;
|
|
require DynaLoader;
|
|
@ISA = qw(DynaLoader);
|
|
}
|
|
}
|
|
|
|
@ISA = qw(Exporter DynaLoader);
|
|
# Items to export into callers namespace by default. Note: do not export
|
|
# names by default without a very good reason. Use EXPORT_OK instead.
|
|
# Do not simply export all your public functions/methods/constants.
|
|
|
|
# NOTE -- Do not add to @EXPORT directly. It is written by mkconsts
|
|
@EXPORT = qw(
|
|
DB2_AM_EXCL
|
|
DB2_AM_INTEXCL
|
|
DB2_AM_MPOOL_OPENED
|
|
DB2_AM_NOWAIT
|
|
DB_AFTER
|
|
DB_AGGRESSIVE
|
|
DB_ALREADY_ABORTED
|
|
DB_APPEND
|
|
DB_APPLY_LOGREG
|
|
DB_APP_INIT
|
|
DB_ARCH_ABS
|
|
DB_ARCH_DATA
|
|
DB_ARCH_LOG
|
|
DB_ARCH_REMOVE
|
|
DB_ASSOC_CREATE
|
|
DB_ASSOC_IMMUTABLE_KEY
|
|
DB_AUTO_COMMIT
|
|
DB_BACKUP_CLEAN
|
|
DB_BACKUP_FILES
|
|
DB_BACKUP_NO_LOGS
|
|
DB_BACKUP_READ_COUNT
|
|
DB_BACKUP_READ_SLEEP
|
|
DB_BACKUP_SINGLE_DIR
|
|
DB_BACKUP_SIZE
|
|
DB_BACKUP_UPDATE
|
|
DB_BACKUP_WRITE_DIRECT
|
|
DB_BEFORE
|
|
DB_BOOTSTRAP_HELPER
|
|
DB_BTREE
|
|
DB_BTREEMAGIC
|
|
DB_BTREEOLDVER
|
|
DB_BTREEVERSION
|
|
DB_BUFFER_SMALL
|
|
DB_CACHED_COUNTS
|
|
DB_CDB_ALLDB
|
|
DB_CHECKPOINT
|
|
DB_CHKSUM
|
|
DB_CHKSUM_FAIL
|
|
DB_CHKSUM_SHA1
|
|
DB_CKP_INTERNAL
|
|
DB_CLIENT
|
|
DB_CL_WRITER
|
|
DB_COMMIT
|
|
DB_COMPACT_FLAGS
|
|
DB_CONSUME
|
|
DB_CONSUME_WAIT
|
|
DB_CONVERT
|
|
DB_CREATE
|
|
DB_CURLSN
|
|
DB_CURRENT
|
|
DB_CURSOR_BULK
|
|
DB_CURSOR_TRANSIENT
|
|
DB_CXX_NO_EXCEPTIONS
|
|
DB_DATABASE_LOCK
|
|
DB_DATABASE_LOCKING
|
|
DB_DEGREE_2
|
|
DB_DELETED
|
|
DB_DELIMITER
|
|
DB_DIRECT
|
|
DB_DIRECT_DB
|
|
DB_DIRECT_LOG
|
|
DB_DIRTY_READ
|
|
DB_DONOTINDEX
|
|
DB_DSYNC_DB
|
|
DB_DSYNC_LOG
|
|
DB_DUP
|
|
DB_DUPCURSOR
|
|
DB_DUPSORT
|
|
DB_DURABLE_UNKNOWN
|
|
DB_EID_BROADCAST
|
|
DB_EID_INVALID
|
|
DB_EID_MASTER
|
|
DB_ENCRYPT
|
|
DB_ENCRYPT_AES
|
|
DB_ENV_APPINIT
|
|
DB_ENV_AUTO_COMMIT
|
|
DB_ENV_CDB
|
|
DB_ENV_CDB_ALLDB
|
|
DB_ENV_CREATE
|
|
DB_ENV_DATABASE_LOCKING
|
|
DB_ENV_DBLOCAL
|
|
DB_ENV_DIRECT_DB
|
|
DB_ENV_DIRECT_LOG
|
|
DB_ENV_DSYNC_DB
|
|
DB_ENV_DSYNC_LOG
|
|
DB_ENV_FAILCHK
|
|
DB_ENV_FATAL
|
|
DB_ENV_HOTBACKUP
|
|
DB_ENV_LOCKDOWN
|
|
DB_ENV_LOCKING
|
|
DB_ENV_LOGGING
|
|
DB_ENV_LOG_AUTOREMOVE
|
|
DB_ENV_LOG_INMEMORY
|
|
DB_ENV_MULTIVERSION
|
|
DB_ENV_NOFLUSH
|
|
DB_ENV_NOLOCKING
|
|
DB_ENV_NOMMAP
|
|
DB_ENV_NOPANIC
|
|
DB_ENV_NO_OUTPUT_SET
|
|
DB_ENV_OPEN_CALLED
|
|
DB_ENV_OVERWRITE
|
|
DB_ENV_PRIVATE
|
|
DB_ENV_RECOVER_FATAL
|
|
DB_ENV_REF_COUNTED
|
|
DB_ENV_REGION_INIT
|
|
DB_ENV_REP_CLIENT
|
|
DB_ENV_REP_LOGSONLY
|
|
DB_ENV_REP_MASTER
|
|
DB_ENV_RPCCLIENT
|
|
DB_ENV_RPCCLIENT_GIVEN
|
|
DB_ENV_STANDALONE
|
|
DB_ENV_SYSTEM_MEM
|
|
DB_ENV_THREAD
|
|
DB_ENV_TIME_NOTGRANTED
|
|
DB_ENV_TXN
|
|
DB_ENV_TXN_NOSYNC
|
|
DB_ENV_TXN_NOT_DURABLE
|
|
DB_ENV_TXN_NOWAIT
|
|
DB_ENV_TXN_SNAPSHOT
|
|
DB_ENV_TXN_WRITE_NOSYNC
|
|
DB_ENV_USER_ALLOC
|
|
DB_ENV_YIELDCPU
|
|
DB_EVENT_FAILCHK_PANIC
|
|
DB_EVENT_MUTEX_DIED
|
|
DB_EVENT_NOT_HANDLED
|
|
DB_EVENT_NO_SUCH_EVENT
|
|
DB_EVENT_PANIC
|
|
DB_EVENT_REG_ALIVE
|
|
DB_EVENT_REG_PANIC
|
|
DB_EVENT_REP_AUTOTAKEOVER
|
|
DB_EVENT_REP_AUTOTAKEOVER_FAILED
|
|
DB_EVENT_REP_CLIENT
|
|
DB_EVENT_REP_CONNECT_BROKEN
|
|
DB_EVENT_REP_CONNECT_ESTD
|
|
DB_EVENT_REP_CONNECT_TRY_FAILED
|
|
DB_EVENT_REP_DUPMASTER
|
|
DB_EVENT_REP_ELECTED
|
|
DB_EVENT_REP_ELECTION_FAILED
|
|
DB_EVENT_REP_INIT_DONE
|
|
DB_EVENT_REP_INQUEUE_FULL
|
|
DB_EVENT_REP_JOIN_FAILURE
|
|
DB_EVENT_REP_LOCAL_SITE_REMOVED
|
|
DB_EVENT_REP_MASTER
|
|
DB_EVENT_REP_MASTER_FAILURE
|
|
DB_EVENT_REP_NEWMASTER
|
|
DB_EVENT_REP_PERM_FAILED
|
|
DB_EVENT_REP_SITE_ADDED
|
|
DB_EVENT_REP_SITE_REMOVED
|
|
DB_EVENT_REP_STARTUPDONE
|
|
DB_EVENT_REP_WOULD_ROLLBACK
|
|
DB_EVENT_WRITE_FAILED
|
|
DB_EXCL
|
|
DB_EXIT_FAILCHK
|
|
DB_EXIT_FILE_EXISTS
|
|
DB_EXTENT
|
|
DB_FAILCHK
|
|
DB_FAILCHK_ISALIVE
|
|
DB_FAILURE_SYMPTOM_SIZE
|
|
DB_FAST_STAT
|
|
DB_FCNTL_LOCKING
|
|
DB_FILEOPEN
|
|
DB_FILE_ID_LEN
|
|
DB_FIRST
|
|
DB_FIXEDLEN
|
|
DB_FLUSH
|
|
DB_FORCE
|
|
DB_FORCESYNC
|
|
DB_FORCESYNCENV
|
|
DB_FOREIGN_ABORT
|
|
DB_FOREIGN_CASCADE
|
|
DB_FOREIGN_CONFLICT
|
|
DB_FOREIGN_NULLIFY
|
|
DB_FREELIST_ONLY
|
|
DB_FREE_SPACE
|
|
DB_GETREC
|
|
DB_GET_BOTH
|
|
DB_GET_BOTHC
|
|
DB_GET_BOTH_LTE
|
|
DB_GET_BOTH_RANGE
|
|
DB_GET_RECNO
|
|
DB_GID_SIZE
|
|
DB_GROUP_CREATOR
|
|
DB_HANDLE_LOCK
|
|
DB_HASH
|
|
DB_HASHMAGIC
|
|
DB_HASHOLDVER
|
|
DB_HASHVERSION
|
|
DB_HEAP
|
|
DB_HEAPMAGIC
|
|
DB_HEAPOLDVER
|
|
DB_HEAPVERSION
|
|
DB_HEAP_FULL
|
|
DB_HEAP_RID_SZ
|
|
DB_HOTBACKUP_IN_PROGRESS
|
|
DB_IGNORE_LEASE
|
|
DB_IMMUTABLE_KEY
|
|
DB_INCOMPLETE
|
|
DB_INIT_CDB
|
|
DB_INIT_LOCK
|
|
DB_INIT_LOG
|
|
DB_INIT_MPOOL
|
|
DB_INIT_MUTEX
|
|
DB_INIT_REP
|
|
DB_INIT_TXN
|
|
DB_INORDER
|
|
DB_INTERNAL_BLOB_DB
|
|
DB_INTERNAL_DB
|
|
DB_INTERNAL_PERSISTENT_DB
|
|
DB_INTERNAL_TEMPORARY_DB
|
|
DB_JAVA_CALLBACK
|
|
DB_JOINENV
|
|
DB_JOIN_ITEM
|
|
DB_JOIN_NOSORT
|
|
DB_KEYEMPTY
|
|
DB_KEYEXIST
|
|
DB_KEYFIRST
|
|
DB_KEYLAST
|
|
DB_LAST
|
|
DB_LEGACY
|
|
DB_LOCAL_SITE
|
|
DB_LOCKDOWN
|
|
DB_LOCKMAGIC
|
|
DB_LOCKVERSION
|
|
DB_LOCK_ABORT
|
|
DB_LOCK_CHECK
|
|
DB_LOCK_CONFLICT
|
|
DB_LOCK_DEADLOCK
|
|
DB_LOCK_DEFAULT
|
|
DB_LOCK_DUMP
|
|
DB_LOCK_EXPIRE
|
|
DB_LOCK_FREE_LOCKER
|
|
DB_LOCK_GET
|
|
DB_LOCK_GET_TIMEOUT
|
|
DB_LOCK_IGNORE_REC
|
|
DB_LOCK_INHERIT
|
|
DB_LOCK_MAXLOCKS
|
|
DB_LOCK_MAXWRITE
|
|
DB_LOCK_MINLOCKS
|
|
DB_LOCK_MINWRITE
|
|
DB_LOCK_NORUN
|
|
DB_LOCK_NOTEXIST
|
|
DB_LOCK_NOTGRANTED
|
|
DB_LOCK_NOTHELD
|
|
DB_LOCK_NOWAIT
|
|
DB_LOCK_OLDEST
|
|
DB_LOCK_PUT
|
|
DB_LOCK_PUT_ALL
|
|
DB_LOCK_PUT_OBJ
|
|
DB_LOCK_PUT_READ
|
|
DB_LOCK_RANDOM
|
|
DB_LOCK_RECORD
|
|
DB_LOCK_REMOVE
|
|
DB_LOCK_RIW_N
|
|
DB_LOCK_RW_N
|
|
DB_LOCK_SET_TIMEOUT
|
|
DB_LOCK_SWITCH
|
|
DB_LOCK_TIMEOUT
|
|
DB_LOCK_TRADE
|
|
DB_LOCK_UPGRADE
|
|
DB_LOCK_UPGRADE_WRITE
|
|
DB_LOCK_YOUNGEST
|
|
DB_LOGCHKSUM
|
|
DB_LOGC_BUF_SIZE
|
|
DB_LOGFILEID_INVALID
|
|
DB_LOGMAGIC
|
|
DB_LOGOLDVER
|
|
DB_LOGVERSION
|
|
DB_LOGVERSION_LATCHING
|
|
DB_LOG_AUTOREMOVE
|
|
DB_LOG_AUTO_REMOVE
|
|
DB_LOG_BLOB
|
|
DB_LOG_BUFFER_FULL
|
|
DB_LOG_CHKPNT
|
|
DB_LOG_COMMIT
|
|
DB_LOG_DIRECT
|
|
DB_LOG_DISK
|
|
DB_LOG_DSYNC
|
|
DB_LOG_EXT_FILE
|
|
DB_LOG_INMEMORY
|
|
DB_LOG_IN_MEMORY
|
|
DB_LOG_LOCKED
|
|
DB_LOG_NOCOPY
|
|
DB_LOG_NOSYNC
|
|
DB_LOG_NOT_DURABLE
|
|
DB_LOG_NO_DATA
|
|
DB_LOG_PERM
|
|
DB_LOG_RESEND
|
|
DB_LOG_SILENT_ERR
|
|
DB_LOG_VERIFY_BAD
|
|
DB_LOG_VERIFY_CAF
|
|
DB_LOG_VERIFY_DBFILE
|
|
DB_LOG_VERIFY_ERR
|
|
DB_LOG_VERIFY_FORWARD
|
|
DB_LOG_VERIFY_INTERR
|
|
DB_LOG_VERIFY_PARTIAL
|
|
DB_LOG_VERIFY_VERBOSE
|
|
DB_LOG_VERIFY_WARNING
|
|
DB_LOG_WRNOSYNC
|
|
DB_LOG_ZERO
|
|
DB_MAX_PAGES
|
|
DB_MAX_RECORDS
|
|
DB_MEM_DATABASE
|
|
DB_MEM_DATABASE_LENGTH
|
|
DB_MEM_EXTFILE_DATABASE
|
|
DB_MEM_LOCK
|
|
DB_MEM_LOCKER
|
|
DB_MEM_LOCKOBJECT
|
|
DB_MEM_LOGID
|
|
DB_MEM_REP_SITE
|
|
DB_MEM_THREAD
|
|
DB_MEM_TRANSACTION
|
|
DB_META_CHKSUM_FAIL
|
|
DB_MPOOL_CLEAN
|
|
DB_MPOOL_CREATE
|
|
DB_MPOOL_DIRTY
|
|
DB_MPOOL_DISCARD
|
|
DB_MPOOL_EDIT
|
|
DB_MPOOL_EXTENT
|
|
DB_MPOOL_FREE
|
|
DB_MPOOL_LAST
|
|
DB_MPOOL_NEW
|
|
DB_MPOOL_NEW_GROUP
|
|
DB_MPOOL_NOFILE
|
|
DB_MPOOL_NOLOCK
|
|
DB_MPOOL_PRIVATE
|
|
DB_MPOOL_TRY
|
|
DB_MPOOL_UNLINK
|
|
DB_MULTIPLE
|
|
DB_MULTIPLE_KEY
|
|
DB_MULTIVERSION
|
|
DB_MUTEXDEBUG
|
|
DB_MUTEXLOCKS
|
|
DB_MUTEX_ALLOCATED
|
|
DB_MUTEX_DESCRIBE_STRLEN
|
|
DB_MUTEX_LOCKED
|
|
DB_MUTEX_LOGICAL_LOCK
|
|
DB_MUTEX_OWNER_DEAD
|
|
DB_MUTEX_PROCESS_ONLY
|
|
DB_MUTEX_SELF_BLOCK
|
|
DB_MUTEX_SHARED
|
|
DB_MUTEX_THREAD
|
|
DB_NEEDSPLIT
|
|
DB_NEXT
|
|
DB_NEXT_DUP
|
|
DB_NEXT_NODUP
|
|
DB_NOCOPY
|
|
DB_NODUPDATA
|
|
DB_NOERROR
|
|
DB_NOFLUSH
|
|
DB_NOINTMP
|
|
DB_NOLOCKING
|
|
DB_NOMMAP
|
|
DB_NOORDERCHK
|
|
DB_NOOVERWRITE
|
|
DB_NOPANIC
|
|
DB_NORECURSE
|
|
DB_NOSERVER
|
|
DB_NOSERVER_HOME
|
|
DB_NOSERVER_ID
|
|
DB_NOSYNC
|
|
DB_NOTFOUND
|
|
DB_NO_AUTO_COMMIT
|
|
DB_NO_CHECKPOINT
|
|
DB_ODDFILESIZE
|
|
DB_OFF_T_MAX
|
|
DB_OK_BTREE
|
|
DB_OK_HASH
|
|
DB_OK_HEAP
|
|
DB_OK_QUEUE
|
|
DB_OK_RECNO
|
|
DB_OLD_VERSION
|
|
DB_OPEN_CALLED
|
|
DB_OPFLAGS_MASK
|
|
DB_ORDERCHKONLY
|
|
DB_OVERWRITE
|
|
DB_OVERWRITE_DUP
|
|
DB_PAD
|
|
DB_PAGEYIELD
|
|
DB_PAGE_LOCK
|
|
DB_PAGE_NOTFOUND
|
|
DB_PANIC_ENVIRONMENT
|
|
DB_PERMANENT
|
|
DB_POSITION
|
|
DB_POSITIONI
|
|
DB_PREV
|
|
DB_PREV_DUP
|
|
DB_PREV_NODUP
|
|
DB_PRINTABLE
|
|
DB_PRIORITY_DEFAULT
|
|
DB_PRIORITY_HIGH
|
|
DB_PRIORITY_LOW
|
|
DB_PRIORITY_UNCHANGED
|
|
DB_PRIORITY_VERY_HIGH
|
|
DB_PRIORITY_VERY_LOW
|
|
DB_PRIVATE
|
|
DB_PR_HEADERS
|
|
DB_PR_PAGE
|
|
DB_PR_RECOVERYTEST
|
|
DB_QAMMAGIC
|
|
DB_QAMOLDVER
|
|
DB_QAMVERSION
|
|
DB_QUEUE
|
|
DB_RDONLY
|
|
DB_RDWRMASTER
|
|
DB_READ_COMMITTED
|
|
DB_READ_UNCOMMITTED
|
|
DB_RECNO
|
|
DB_RECNUM
|
|
DB_RECORDCOUNT
|
|
DB_RECORD_LOCK
|
|
DB_RECOVER
|
|
DB_RECOVER_FATAL
|
|
DB_REGION_ANON
|
|
DB_REGION_INIT
|
|
DB_REGION_MAGIC
|
|
DB_REGION_MAGIC_RECOVER
|
|
DB_REGION_NAME
|
|
DB_REGISTER
|
|
DB_REGISTERED
|
|
DB_RENAMEMAGIC
|
|
DB_RENUMBER
|
|
DB_REPFLAGS_MASK
|
|
DB_REPMGR_ACKS_ALL
|
|
DB_REPMGR_ACKS_ALL_AVAILABLE
|
|
DB_REPMGR_ACKS_ALL_PEERS
|
|
DB_REPMGR_ACKS_NONE
|
|
DB_REPMGR_ACKS_ONE
|
|
DB_REPMGR_ACKS_ONE_PEER
|
|
DB_REPMGR_ACKS_QUORUM
|
|
DB_REPMGR_CONF_2SITE_STRICT
|
|
DB_REPMGR_CONF_DISABLE_POLL
|
|
DB_REPMGR_CONF_ELECTIONS
|
|
DB_REPMGR_CONF_ENABLE_EPOLL
|
|
DB_REPMGR_CONF_FORWARD_WRITES
|
|
DB_REPMGR_CONF_PREFMAS_CLIENT
|
|
DB_REPMGR_CONF_PREFMAS_MASTER
|
|
DB_REPMGR_CONNECTED
|
|
DB_REPMGR_DISCONNECTED
|
|
DB_REPMGR_ISELECTABLE
|
|
DB_REPMGR_ISPEER
|
|
DB_REPMGR_ISVIEW
|
|
DB_REPMGR_NEED_RESPONSE
|
|
DB_REPMGR_PEER
|
|
DB_REP_ACK_TIMEOUT
|
|
DB_REP_ANYWHERE
|
|
DB_REP_BULKOVF
|
|
DB_REP_CHECKPOINT_DELAY
|
|
DB_REP_CLIENT
|
|
DB_REP_CONF_AUTOINIT
|
|
DB_REP_CONF_AUTOROLLBACK
|
|
DB_REP_CONF_BULK
|
|
DB_REP_CONF_DELAYCLIENT
|
|
DB_REP_CONF_ELECT_LOGLENGTH
|
|
DB_REP_CONF_INMEM
|
|
DB_REP_CONF_LEASE
|
|
DB_REP_CONF_NOAUTOINIT
|
|
DB_REP_CONF_NOWAIT
|
|
DB_REP_CONNECTION_RETRY
|
|
DB_REP_CREATE
|
|
DB_REP_DEFAULT_PRIORITY
|
|
DB_REP_DUPMASTER
|
|
DB_REP_EGENCHG
|
|
DB_REP_ELECTION
|
|
DB_REP_ELECTION_RETRY
|
|
DB_REP_ELECTION_TIMEOUT
|
|
DB_REP_FULL_ELECTION
|
|
DB_REP_FULL_ELECTION_TIMEOUT
|
|
DB_REP_HANDLE_DEAD
|
|
DB_REP_HEARTBEAT_MONITOR
|
|
DB_REP_HEARTBEAT_SEND
|
|
DB_REP_HOLDELECTION
|
|
DB_REP_IGNORE
|
|
DB_REP_INELECT
|
|
DB_REP_ISPERM
|
|
DB_REP_JOIN_FAILURE
|
|
DB_REP_LEASE_EXPIRED
|
|
DB_REP_LEASE_TIMEOUT
|
|
DB_REP_LOCKOUT
|
|
DB_REP_LOGREADY
|
|
DB_REP_LOGSONLY
|
|
DB_REP_MASTER
|
|
DB_REP_NEWMASTER
|
|
DB_REP_NEWSITE
|
|
DB_REP_NOBUFFER
|
|
DB_REP_NOTPERM
|
|
DB_REP_OUTDATED
|
|
DB_REP_PAGEDONE
|
|
DB_REP_PAGELOCKED
|
|
DB_REP_PERMANENT
|
|
DB_REP_REREQUEST
|
|
DB_REP_STARTUPDONE
|
|
DB_REP_UNAVAIL
|
|
DB_REP_WOULDROLLBACK
|
|
DB_REP_WRITE_FORWARD_TIMEOUT
|
|
DB_REVSPLITOFF
|
|
DB_RMW
|
|
DB_RPCCLIENT
|
|
DB_RPC_SERVERPROG
|
|
DB_RPC_SERVERVERS
|
|
DB_RUNRECOVERY
|
|
DB_SALVAGE
|
|
DB_SA_SKIPFIRSTKEY
|
|
DB_SA_UNKNOWNKEY
|
|
DB_SECONDARY_BAD
|
|
DB_SEQUENCE_OLDVER
|
|
DB_SEQUENCE_VERSION
|
|
DB_SEQUENTIAL
|
|
DB_SEQ_DEC
|
|
DB_SEQ_INC
|
|
DB_SEQ_RANGE_SET
|
|
DB_SEQ_WRAP
|
|
DB_SEQ_WRAPPED
|
|
DB_SET
|
|
DB_SET_LOCK_TIMEOUT
|
|
DB_SET_LTE
|
|
DB_SET_MUTEX_FAILCHK_TIMEOUT
|
|
DB_SET_RANGE
|
|
DB_SET_RECNO
|
|
DB_SET_REG_TIMEOUT
|
|
DB_SET_TXN_NOW
|
|
DB_SET_TXN_TIMEOUT
|
|
DB_SHALLOW_DUP
|
|
DB_SLICED
|
|
DB_SLICE_CORRUPT
|
|
DB_SNAPSHOT
|
|
DB_SPARE_FLAG
|
|
DB_STAT_ALL
|
|
DB_STAT_ALLOC
|
|
DB_STAT_CLEAR
|
|
DB_STAT_LOCK_CONF
|
|
DB_STAT_LOCK_LOCKERS
|
|
DB_STAT_LOCK_OBJECTS
|
|
DB_STAT_LOCK_PARAMS
|
|
DB_STAT_MEMP_HASH
|
|
DB_STAT_MEMP_NOERROR
|
|
DB_STAT_NOERROR
|
|
DB_STAT_SUBSYSTEM
|
|
DB_STAT_SUMMARY
|
|
DB_STREAM_READ
|
|
DB_STREAM_SYNC_WRITE
|
|
DB_STREAM_WRITE
|
|
DB_ST_DUPOK
|
|
DB_ST_DUPSET
|
|
DB_ST_DUPSORT
|
|
DB_ST_IS_RECNO
|
|
DB_ST_OVFL_LEAF
|
|
DB_ST_RECNUM
|
|
DB_ST_RELEN
|
|
DB_ST_TOPLEVEL
|
|
DB_SURPRISE_KID
|
|
DB_SWAPBYTES
|
|
DB_SYSTEM_MEM
|
|
DB_SYSTEM_MEM_MISSING
|
|
DB_TEMPORARY
|
|
DB_TEST_ELECTINIT
|
|
DB_TEST_ELECTSEND
|
|
DB_TEST_ELECTVOTE1
|
|
DB_TEST_ELECTVOTE2
|
|
DB_TEST_ELECTWAIT1
|
|
DB_TEST_ELECTWAIT2
|
|
DB_TEST_POSTDESTROY
|
|
DB_TEST_POSTLOG
|
|
DB_TEST_POSTLOGMETA
|
|
DB_TEST_POSTOPEN
|
|
DB_TEST_POSTRENAME
|
|
DB_TEST_POSTSYNC
|
|
DB_TEST_PREDESTROY
|
|
DB_TEST_PREOPEN
|
|
DB_TEST_PRERENAME
|
|
DB_TEST_RECYCLE
|
|
DB_TEST_SUBDB_LOCKS
|
|
DB_THREAD
|
|
DB_THREADID_STRLEN
|
|
DB_TIMEOUT
|
|
DB_TIME_NOTGRANTED
|
|
DB_TRUNCATE
|
|
DB_TXNMAGIC
|
|
DB_TXNVERSION
|
|
DB_TXN_ABORT
|
|
DB_TXN_APPLY
|
|
DB_TXN_BACKWARD_ROLL
|
|
DB_TXN_BULK
|
|
DB_TXN_CKP
|
|
DB_TXN_DISPATCH
|
|
DB_TXN_FAMILY
|
|
DB_TXN_FORWARD_ROLL
|
|
DB_TXN_LOCK
|
|
DB_TXN_LOCK_2PL
|
|
DB_TXN_LOCK_MASK
|
|
DB_TXN_LOCK_OPTIMIST
|
|
DB_TXN_LOCK_OPTIMISTIC
|
|
DB_TXN_LOG_MASK
|
|
DB_TXN_LOG_REDO
|
|
DB_TXN_LOG_UNDO
|
|
DB_TXN_LOG_UNDOREDO
|
|
DB_TXN_LOG_VERIFY
|
|
DB_TXN_NOSYNC
|
|
DB_TXN_NOT_DURABLE
|
|
DB_TXN_NOWAIT
|
|
DB_TXN_OPENFILES
|
|
DB_TXN_POPENFILES
|
|
DB_TXN_PRINT
|
|
DB_TXN_REDO
|
|
DB_TXN_SNAPSHOT
|
|
DB_TXN_SYNC
|
|
DB_TXN_TOKEN_SIZE
|
|
DB_TXN_UNDO
|
|
DB_TXN_WAIT
|
|
DB_TXN_WRITE_NOSYNC
|
|
DB_UNKNOWN
|
|
DB_UNREF
|
|
DB_UPDATE_SECONDARY
|
|
DB_UPGRADE
|
|
DB_USERCOPY_GETDATA
|
|
DB_USERCOPY_SETDATA
|
|
DB_USE_ENVIRON
|
|
DB_USE_ENVIRON_ROOT
|
|
DB_VERB_BACKUP
|
|
DB_VERB_CHKPOINT
|
|
DB_VERB_DEADLOCK
|
|
DB_VERB_FILEOPS
|
|
DB_VERB_FILEOPS_ALL
|
|
DB_VERB_MVCC
|
|
DB_VERB_RECOVERY
|
|
DB_VERB_REGISTER
|
|
DB_VERB_REPLICATION
|
|
DB_VERB_REPMGR_CONNFAIL
|
|
DB_VERB_REPMGR_MISC
|
|
DB_VERB_REP_ELECT
|
|
DB_VERB_REP_LEASE
|
|
DB_VERB_REP_MISC
|
|
DB_VERB_REP_MSGS
|
|
DB_VERB_REP_SYNC
|
|
DB_VERB_REP_SYSTEM
|
|
DB_VERB_REP_TEST
|
|
DB_VERB_SLICE
|
|
DB_VERB_WAITSFOR
|
|
DB_VERIFY
|
|
DB_VERIFY_BAD
|
|
DB_VERIFY_FATAL
|
|
DB_VERIFY_PARTITION
|
|
DB_VERSION_FAMILY
|
|
DB_VERSION_FULL_STRING
|
|
DB_VERSION_MAJOR
|
|
DB_VERSION_MINOR
|
|
DB_VERSION_MISMATCH
|
|
DB_VERSION_PATCH
|
|
DB_VERSION_RELEASE
|
|
DB_VERSION_STRING
|
|
DB_VRFY_FLAGMASK
|
|
DB_WRITECURSOR
|
|
DB_WRITELOCK
|
|
DB_WRITEOPEN
|
|
DB_WRNOSYNC
|
|
DB_XA_CREATE
|
|
DB_XIDDATASIZE
|
|
DB_YIELDCPU
|
|
DB_debug_FLAG
|
|
DB_user_BEGIN
|
|
EPOLL
|
|
HAVE_EPOLL
|
|
LOGREC_ARG
|
|
LOGREC_DATA
|
|
LOGREC_DB
|
|
LOGREC_DBOP
|
|
LOGREC_DBT
|
|
LOGREC_Done
|
|
LOGREC_HDR
|
|
LOGREC_LOCKS
|
|
LOGREC_LONGARG
|
|
LOGREC_OP
|
|
LOGREC_PGDBT
|
|
LOGREC_PGDDBT
|
|
LOGREC_PGLIST
|
|
LOGREC_POINTER
|
|
LOGREC_TIME
|
|
POLL
|
|
SELECT
|
|
);
|
|
|
|
sub AUTOLOAD {
|
|
my($constname);
|
|
($constname = $AUTOLOAD) =~ s/.*:://;
|
|
my ($error, $val) = constant($constname);
|
|
Carp::croak $error if $error;
|
|
no strict 'refs';
|
|
*{$AUTOLOAD} = sub { $val };
|
|
goto &{$AUTOLOAD};
|
|
}
|
|
|
|
#bootstrap BerkeleyDB $VERSION;
|
|
if ($use_XSLoader)
|
|
{ XSLoader::load("BerkeleyDB", $VERSION)}
|
|
else
|
|
{ bootstrap BerkeleyDB $VERSION }
|
|
|
|
# Preloaded methods go here.
|
|
|
|
|
|
sub ParseParameters($@)
|
|
{
|
|
my ($default, @rest) = @_ ;
|
|
my (%got) = %$default ;
|
|
my (@Bad) ;
|
|
my ($key, $value) ;
|
|
my $sub = (caller(1))[3] ;
|
|
my %options = () ;
|
|
local ($Carp::CarpLevel) = 1 ;
|
|
|
|
# allow the options to be passed as a hash reference or
|
|
# as the complete hash.
|
|
if (@rest == 1) {
|
|
|
|
croak "$sub: parameter is not a reference to a hash"
|
|
if ref $rest[0] ne "HASH" ;
|
|
|
|
%options = %{ $rest[0] } ;
|
|
}
|
|
elsif (@rest >= 2 && @rest % 2 == 0) {
|
|
%options = @rest ;
|
|
}
|
|
elsif (@rest > 0) {
|
|
croak "$sub: malformed option list";
|
|
}
|
|
|
|
while (($key, $value) = each %options)
|
|
{
|
|
$key =~ s/^-// ;
|
|
|
|
if (exists $default->{$key})
|
|
{ $got{$key} = $value }
|
|
else
|
|
{ push (@Bad, $key) }
|
|
}
|
|
|
|
if (@Bad) {
|
|
my ($bad) = join(", ", @Bad) ;
|
|
croak "unknown key value(s) $bad" ;
|
|
}
|
|
|
|
return \%got ;
|
|
}
|
|
|
|
sub parseEncrypt
|
|
{
|
|
my $got = shift ;
|
|
|
|
|
|
if (defined $got->{Encrypt}) {
|
|
croak("Encrypt parameter must be a hash reference")
|
|
if !ref $got->{Encrypt} || ref $got->{Encrypt} ne 'HASH' ;
|
|
|
|
my %config = %{ $got->{Encrypt} } ;
|
|
|
|
my $p = BerkeleyDB::ParseParameters({
|
|
Password => undef,
|
|
Flags => undef,
|
|
}, %config);
|
|
|
|
croak("Must specify Password and Flags with Encrypt parameter")
|
|
if ! (defined $p->{Password} && defined $p->{Flags});
|
|
|
|
$got->{"Enc_Passwd"} = $p->{Password};
|
|
$got->{"Enc_Flags"} = $p->{Flags};
|
|
}
|
|
}
|
|
|
|
use UNIVERSAL ;
|
|
|
|
sub env_remove
|
|
{
|
|
# Usage:
|
|
#
|
|
# $env = BerkeleyDB::env_remove
|
|
# [ -Home => $path, ]
|
|
# [ -Config => { name => value, name => value }
|
|
# [ -Flags => DB_INIT_LOCK| ]
|
|
# ;
|
|
|
|
my $got = BerkeleyDB::ParseParameters({
|
|
Home => undef,
|
|
Flags => 0,
|
|
Config => undef,
|
|
}, @_) ;
|
|
|
|
if (defined $got->{Config}) {
|
|
croak("Config parameter must be a hash reference")
|
|
if ! ref $got->{Config} eq 'HASH' ;
|
|
|
|
@BerkeleyDB::a = () ;
|
|
my $k = "" ; my $v = "" ;
|
|
while (($k, $v) = each %{$got->{Config}}) {
|
|
push @BerkeleyDB::a, "$k\t$v" ;
|
|
}
|
|
|
|
$got->{"Config"} = pack("p*", @BerkeleyDB::a, undef)
|
|
if @BerkeleyDB::a ;
|
|
}
|
|
|
|
return _env_remove($got) ;
|
|
}
|
|
|
|
sub db_remove
|
|
{
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
Filename => undef,
|
|
Subname => undef,
|
|
Flags => 0,
|
|
Env => undef,
|
|
Txn => undef,
|
|
}, @_) ;
|
|
|
|
croak("Must specify a filename")
|
|
if ! defined $got->{Filename} ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
return _db_remove($got);
|
|
}
|
|
|
|
sub db_rename
|
|
{
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
Filename => undef,
|
|
Subname => undef,
|
|
Newname => undef,
|
|
Flags => 0,
|
|
Env => undef,
|
|
Txn => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Must specify a filename")
|
|
if ! defined $got->{Filename} ;
|
|
|
|
#croak("Must specify a Subname")
|
|
#if ! defined $got->{Subname} ;
|
|
|
|
croak("Must specify a Newname")
|
|
if ! defined $got->{Newname} ;
|
|
|
|
return _db_rename($got);
|
|
}
|
|
|
|
sub db_verify
|
|
{
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
Filename => undef,
|
|
Subname => undef,
|
|
Outfile => undef,
|
|
Flags => 0,
|
|
Env => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Must specify a filename")
|
|
if ! defined $got->{Filename} ;
|
|
|
|
return _db_verify($got);
|
|
}
|
|
|
|
package BerkeleyDB::Env ;
|
|
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
use IO::File;
|
|
use vars qw( %valid_config_keys ) ;
|
|
|
|
sub isaFilehandle
|
|
{
|
|
my $fh = shift ;
|
|
|
|
return ((UNIVERSAL::isa($fh,'GLOB') or UNIVERSAL::isa(\$fh,'GLOB')) and defined fileno($fh) )
|
|
|
|
}
|
|
|
|
%valid_config_keys = map { $_, 1 } qw( DB_DATA_DIR DB_LOG_DIR DB_TEMP_DIR
|
|
DB_TMP_DIR ) ;
|
|
|
|
sub new
|
|
{
|
|
# Usage:
|
|
#
|
|
# $env = new BerkeleyDB::Env
|
|
# [ -Home => $path, ]
|
|
# [ -Mode => mode, ]
|
|
# [ -Config => { name => value, name => value }
|
|
# [ -ErrFile => filename, ]
|
|
# [ -ErrPrefix => "string", ]
|
|
# [ -Flags => DB_INIT_LOCK| ]
|
|
# [ -Set_Flags => $flags,]
|
|
# [ -Cachesize => number ]
|
|
# [ -LockDetect => ]
|
|
# [ -Verbose => boolean ]
|
|
# [ -Encrypt => { Password => string, Flags => value}
|
|
#
|
|
# ;
|
|
|
|
my $pkg = shift ;
|
|
my $got = BerkeleyDB::ParseParameters({
|
|
Home => undef,
|
|
Server => undef,
|
|
Mode => 0666,
|
|
ErrFile => undef,
|
|
MsgFile => undef,
|
|
ErrPrefix => undef,
|
|
Flags => 0,
|
|
SetFlags => 0,
|
|
Cachesize => 0,
|
|
LockDetect => 0,
|
|
TxMax => 0,
|
|
LogConfig => 0,
|
|
LogFileMode => undef,
|
|
MaxLockers => 0,
|
|
MaxLocks => 0,
|
|
MaxObjects => 0,
|
|
Verbose => 0,
|
|
Config => undef,
|
|
Encrypt => undef,
|
|
SharedMemKey => undef,
|
|
Set_Lk_Exclusive => undef,
|
|
ThreadCount => 0,
|
|
BlobThreshold => 0,
|
|
BlobDir => undef,
|
|
}, @_) ;
|
|
|
|
my $errfile = $got->{ErrFile} ;
|
|
if (defined $got->{ErrFile}) {
|
|
if (!isaFilehandle($got->{ErrFile})) {
|
|
my $handle = new IO::File ">$got->{ErrFile}"
|
|
or croak "Cannot open file $got->{ErrFile}: $!\n" ;
|
|
$errfile = $got->{ErrFile} = $handle ;
|
|
}
|
|
}
|
|
|
|
if (defined $got->{MsgFile}) {
|
|
my $msgfile = $got->{MsgFile} ;
|
|
if (!isaFilehandle($msgfile)) {
|
|
my $handle = new IO::File ">$msgfile"
|
|
or croak "Cannot open file $msgfile: $!\n" ;
|
|
$got->{MsgFile} = $handle ;
|
|
}
|
|
}
|
|
|
|
my %config ;
|
|
if (defined $got->{Config}) {
|
|
croak("Config parameter must be a hash reference")
|
|
if ! ref $got->{Config} eq 'HASH' ;
|
|
|
|
%config = %{ $got->{Config} } ;
|
|
@BerkeleyDB::a = () ;
|
|
my $k = "" ; my $v = "" ;
|
|
while (($k, $v) = each %config) {
|
|
if ($BerkeleyDB::db_version >= 3.1 && ! $valid_config_keys{$k} ){
|
|
$BerkeleyDB::Error = "illegal name-value pair: $k $v\n" ;
|
|
croak $BerkeleyDB::Error ;
|
|
}
|
|
push @BerkeleyDB::a, "$k\t$v" ;
|
|
$got->{$k} = $v;
|
|
}
|
|
|
|
$got->{"Config"} = pack("p*", @BerkeleyDB::a, undef)
|
|
if @BerkeleyDB::a ;
|
|
}
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
my ($addr) = _db_appinit($pkg, $got, $errfile);
|
|
my $obj ;
|
|
$obj = bless [$addr] , $pkg if $addr ;
|
|
# if ($obj && $BerkeleyDB::db_version >= 3.1 && keys %config) {
|
|
# my ($k, $v);
|
|
# while (($k, $v) = each %config) {
|
|
# if ($k eq 'DB_DATA_DIR')
|
|
# { $obj->set_data_dir($v) }
|
|
# elsif ($k eq 'DB_LOG_DIR')
|
|
# { $obj->set_lg_dir($v) }
|
|
# elsif ($k eq 'DB_TEMP_DIR' || $k eq 'DB_TMP_DIR')
|
|
# { $obj->set_tmp_dir($v) }
|
|
# else {
|
|
# $BerkeleyDB::Error = "illegal name-value pair: $k $v\n" ;
|
|
# croak $BerkeleyDB::Error
|
|
# }
|
|
# }
|
|
# }
|
|
return $obj ;
|
|
}
|
|
|
|
|
|
sub TxnMgr
|
|
{
|
|
my $env = shift ;
|
|
my ($addr) = $env->_TxnMgr() ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $env] , "BerkeleyDB::TxnMgr" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub txn_begin
|
|
{
|
|
my $env = shift ;
|
|
my ($addr) = $env->_txn_begin(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $env] , "BerkeleyDB::Txn" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
$self->_DESTROY() ;
|
|
}
|
|
|
|
sub STORABLE_freeze
|
|
{
|
|
my $type = ref shift;
|
|
croak "Cannot freeze $type object\n";
|
|
}
|
|
|
|
sub STORABLE_thaw
|
|
{
|
|
my $type = ref shift;
|
|
croak "Cannot thaw $type object\n";
|
|
}
|
|
|
|
package BerkeleyDB::Hash ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
#Tie => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
# Hash specific
|
|
Ffactor => 0,
|
|
Nelem => 0,
|
|
Hash => undef,
|
|
DupCompare => undef,
|
|
|
|
# BerkeleyDB specific
|
|
ReadKey => undef,
|
|
WriteKey => undef,
|
|
ReadValue => undef,
|
|
WriteValue => undef,
|
|
|
|
# Blob
|
|
BlobThreshold => 0,
|
|
BlobDir => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
croak("-Tie needs a reference to a hash")
|
|
if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
my ($addr) = _db_open_hash($self, $got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr] , $self ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
*TIEHASH = \&new ;
|
|
|
|
|
|
package BerkeleyDB::Btree ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
#Tie => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
# Btree specific
|
|
Minkey => 0,
|
|
Compare => undef,
|
|
DupCompare => undef,
|
|
Prefix => undef,
|
|
set_bt_compress => undef,
|
|
|
|
# Blob
|
|
BlobThreshold => 0,
|
|
BlobDir => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
croak("-Tie needs a reference to a hash")
|
|
if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
|
|
|
|
# if (defined $got->{set_bt_compress} )
|
|
# {
|
|
#
|
|
# croak("-set_bt_compress needs a reference to a 2-element array")
|
|
# if $got->{set_bt_compress} !~ /ARRAY/ ||
|
|
#
|
|
# croak("-set_bt_compress needs a reference to a 2-element array")
|
|
# if $got->{set_bt_compress} !~ /ARRAY/ ||
|
|
# @{ $got->{set_bt_compress} } != 2;
|
|
#
|
|
# $got->{"_btcompress1"} = $got->{set_bt_compress}[0]
|
|
# if defined $got->{set_bt_compress}[0];
|
|
#
|
|
# $got->{"_btcompress2"} = $got->{set_bt_compress}[1]
|
|
# if defined $got->{set_bt_compress}[1];
|
|
# }
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
my ($addr) = _db_open_btree($self, $got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr] , $self ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
*BerkeleyDB::Btree::TIEHASH = \&BerkeleyDB::Btree::new ;
|
|
|
|
package BerkeleyDB::Heap ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedHash ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
# Heap specific
|
|
HeapSize => undef,
|
|
HeapSizeGb => undef,
|
|
|
|
# Blob
|
|
BlobThreshold => 0,
|
|
BlobDir => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
# if (defined $got->{HeapSize} )
|
|
# {
|
|
#
|
|
# croak("-HeapSize needs a reference to a 2-element array")
|
|
# if $got->{HeapSize} !~ /ARRAY/ ||
|
|
#
|
|
# croak("-HeapSize needs a reference to a 2-element array")
|
|
# if $got->{HeapSize} !~ /ARRAY/ ||
|
|
# @{ $got->{set_bt_compress} } != 2;
|
|
#
|
|
# $got->{"HeapSize"} = $got->{HeapSize}[0]
|
|
# if defined $got->{HeapSize}[0];
|
|
#
|
|
# $got->{"HeapSize"} = $got->{HeapSize}[1]
|
|
# if defined $got->{HeapSize}[1];
|
|
# }
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
my ($addr) = _db_open_heap($self, $got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr] , $self ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
sub TIEHASH
|
|
{
|
|
die "Tied Hash interface not supported with BerkeleyDB::Heap\n" ;
|
|
}
|
|
|
|
|
|
package BerkeleyDB::Recno ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
#Tie => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
# Recno specific
|
|
Delim => undef,
|
|
Len => undef,
|
|
Pad => undef,
|
|
Source => undef,
|
|
ArrayBase => 1, # lowest index in array
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
croak("Tie needs a reference to an array")
|
|
if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ;
|
|
|
|
croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}")
|
|
if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ;
|
|
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
$got->{Fname} = $got->{Filename} if defined $got->{Filename} ;
|
|
|
|
my ($addr) = _db_open_recno($self, $got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr] , $self ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
*BerkeleyDB::Recno::TIEARRAY = \&BerkeleyDB::Recno::new ;
|
|
*BerkeleyDB::Recno::db_stat = \&BerkeleyDB::Btree::db_stat ;
|
|
|
|
package BerkeleyDB::Queue ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
#Tie => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
# Queue specific
|
|
Len => undef,
|
|
Pad => undef,
|
|
ArrayBase => 1, # lowest index in array
|
|
ExtentSize => undef,
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
croak("Tie needs a reference to an array")
|
|
if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ;
|
|
|
|
croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}")
|
|
if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ;
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
$got->{Fname} = $got->{Filename} if defined $got->{Filename} ;
|
|
|
|
my ($addr) = _db_open_queue($self, $got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr] , $self ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
*BerkeleyDB::Queue::TIEARRAY = \&BerkeleyDB::Queue::new ;
|
|
|
|
sub UNSHIFT
|
|
{
|
|
my $self = shift;
|
|
croak "unshift is unsupported with Queue databases";
|
|
}
|
|
|
|
## package BerkeleyDB::Text ;
|
|
##
|
|
## use vars qw(@ISA) ;
|
|
## @ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
|
|
## use UNIVERSAL ;
|
|
## use Carp ;
|
|
##
|
|
## sub new
|
|
## {
|
|
## my $self = shift ;
|
|
## my $got = BerkeleyDB::ParseParameters(
|
|
## {
|
|
## # Generic Stuff
|
|
## Filename => undef,
|
|
## #Flags => BerkeleyDB::DB_CREATE(),
|
|
## Flags => 0,
|
|
## Property => 0,
|
|
## Mode => 0666,
|
|
## Cachesize => 0,
|
|
## Lorder => 0,
|
|
## Pagesize => 0,
|
|
## Env => undef,
|
|
## #Tie => undef,
|
|
## Txn => undef,
|
|
##
|
|
## # Recno specific
|
|
## Delim => undef,
|
|
## Len => undef,
|
|
## Pad => undef,
|
|
## Btree => undef,
|
|
## }, @_) ;
|
|
##
|
|
## croak("Env not of type BerkeleyDB::Env")
|
|
## if defined $got->{Env} and ! isa($got->{Env},'BerkeleyDB::Env');
|
|
##
|
|
## croak("Txn not of type BerkeleyDB::Txn")
|
|
## if defined $got->{Txn} and ! isa($got->{Txn},'BerkeleyDB::Txn');
|
|
##
|
|
## croak("-Tie needs a reference to an array")
|
|
## if defined $got->{Tie} and $got->{Tie} !~ /ARRAY/ ;
|
|
##
|
|
## # rearange for recno
|
|
## $got->{Source} = $got->{Filename} if defined $got->{Filename} ;
|
|
## delete $got->{Filename} ;
|
|
## $got->{Fname} = $got->{Btree} if defined $got->{Btree} ;
|
|
## return BerkeleyDB::Recno::_db_open_recno($self, $got);
|
|
## }
|
|
##
|
|
## *BerkeleyDB::Text::TIEARRAY = \&BerkeleyDB::Text::new ;
|
|
## *BerkeleyDB::Text::db_stat = \&BerkeleyDB::Btree::db_stat ;
|
|
|
|
package BerkeleyDB::Unknown ;
|
|
|
|
use vars qw(@ISA) ;
|
|
@ISA = qw( BerkeleyDB::Common BerkeleyDB::_tiedArray ) ;
|
|
use UNIVERSAL ;
|
|
use Carp ;
|
|
|
|
sub new
|
|
{
|
|
my $self = shift ;
|
|
my $got = BerkeleyDB::ParseParameters(
|
|
{
|
|
# Generic Stuff
|
|
Filename => undef,
|
|
Subname => undef,
|
|
#Flags => BerkeleyDB::DB_CREATE(),
|
|
Flags => 0,
|
|
Property => 0,
|
|
Mode => 0666,
|
|
Cachesize => 0,
|
|
Lorder => 0,
|
|
Pagesize => 0,
|
|
Env => undef,
|
|
#Tie => undef,
|
|
Txn => undef,
|
|
Encrypt => undef,
|
|
|
|
}, @_) ;
|
|
|
|
croak("Env not of type BerkeleyDB::Env")
|
|
if defined $got->{Env} and ! UNIVERSAL::isa($got->{Env},'BerkeleyDB::Env');
|
|
|
|
croak("Txn not of type BerkeleyDB::Txn")
|
|
if defined $got->{Txn} and ! UNIVERSAL::isa($got->{Txn},'BerkeleyDB::Txn');
|
|
|
|
croak("-Tie needs a reference to a hash")
|
|
if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ;
|
|
|
|
BerkeleyDB::parseEncrypt($got);
|
|
|
|
my ($addr, $type) = _db_open_unknown($got);
|
|
my $obj ;
|
|
if ($addr) {
|
|
$obj = bless [$addr], "BerkeleyDB::$type" ;
|
|
push @{ $obj }, $got->{Env} if $got->{Env} ;
|
|
$obj->Txn($got->{Txn})
|
|
if $got->{Txn} ;
|
|
}
|
|
return $obj ;
|
|
}
|
|
|
|
|
|
package BerkeleyDB::_tiedHash ;
|
|
|
|
use Carp ;
|
|
|
|
#sub TIEHASH
|
|
#{
|
|
# my $self = shift ;
|
|
# my $db_object = shift ;
|
|
#
|
|
#print "Tiehash REF=[$self] [" . (ref $self) . "]\n" ;
|
|
#
|
|
# return bless { Obj => $db_object}, $self ;
|
|
#}
|
|
|
|
sub Tie
|
|
{
|
|
# Usage:
|
|
#
|
|
# $db->Tie \%hash ;
|
|
#
|
|
|
|
my $self = shift ;
|
|
|
|
#print "Tie method REF=[$self] [" . (ref $self) . "]\n" ;
|
|
|
|
croak("usage \$x->Tie \\%hash\n") unless @_ ;
|
|
my $ref = shift ;
|
|
|
|
croak("Tie needs a reference to a hash")
|
|
if defined $ref and $ref !~ /HASH/ ;
|
|
|
|
#tie %{ $ref }, ref($self), $self ;
|
|
tie %{ $ref }, "BerkeleyDB::_tiedHash", $self ;
|
|
return undef ;
|
|
}
|
|
|
|
|
|
sub TIEHASH
|
|
{
|
|
my $self = shift ;
|
|
my $db_object = shift ;
|
|
#return bless $db_object, 'BerkeleyDB::Common' ;
|
|
return $db_object ;
|
|
}
|
|
|
|
sub STORE
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
my $value = shift ;
|
|
|
|
$self->db_put($key, $value) ;
|
|
}
|
|
|
|
sub FETCH
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
my $value = undef ;
|
|
$self->db_get($key, $value) ;
|
|
|
|
return $value ;
|
|
}
|
|
|
|
sub EXISTS
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
my $value = undef ;
|
|
$self->db_get($key, $value) == 0 ;
|
|
}
|
|
|
|
sub DELETE
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
$self->db_del($key) ;
|
|
}
|
|
|
|
sub CLEAR_old
|
|
{
|
|
my $self = shift ;
|
|
my ($key, $value) = (0, 0) ;
|
|
my $cursor = $self->_db_write_cursor() ;
|
|
while ($cursor->c_get($key, $value, BerkeleyDB::DB_PREV()) == 0)
|
|
{ $cursor->c_del() }
|
|
}
|
|
|
|
sub CLEAR_new
|
|
{
|
|
my $self = shift ;
|
|
$self->truncate(my $count);
|
|
}
|
|
|
|
*CLEAR = $BerkeleyDB::db_version < 4 ? \&CLEAR_old : \&CLEAR_new ;
|
|
|
|
#sub DESTROY
|
|
#{
|
|
# my $self = shift ;
|
|
# print "BerkeleyDB::_tieHash::DESTROY\n" ;
|
|
# $self->{Cursor}->c_close() if $self->{Cursor} ;
|
|
#}
|
|
|
|
package BerkeleyDB::_tiedArray ;
|
|
|
|
use Carp ;
|
|
|
|
sub Tie
|
|
{
|
|
# Usage:
|
|
#
|
|
# $db->Tie \@array ;
|
|
#
|
|
|
|
my $self = shift ;
|
|
|
|
#print "Tie method REF=[$self] [" . (ref $self) . "]\n" ;
|
|
|
|
croak("usage \$x->Tie \\%hash\n") unless @_ ;
|
|
my $ref = shift ;
|
|
|
|
croak("Tie needs a reference to an array")
|
|
if defined $ref and $ref !~ /ARRAY/ ;
|
|
|
|
#tie %{ $ref }, ref($self), $self ;
|
|
tie @{ $ref }, "BerkeleyDB::_tiedArray", $self ;
|
|
return undef ;
|
|
}
|
|
|
|
|
|
#sub TIEARRAY
|
|
#{
|
|
# my $self = shift ;
|
|
# my $db_object = shift ;
|
|
#
|
|
#print "Tiearray REF=[$self] [" . (ref $self) . "]\n" ;
|
|
#
|
|
# return bless { Obj => $db_object}, $self ;
|
|
#}
|
|
|
|
sub TIEARRAY
|
|
{
|
|
my $self = shift ;
|
|
my $db_object = shift ;
|
|
#return bless $db_object, 'BerkeleyDB::Common' ;
|
|
return $db_object ;
|
|
}
|
|
|
|
sub STORE
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
my $value = shift ;
|
|
|
|
$self->db_put($key, $value) ;
|
|
}
|
|
|
|
sub FETCH
|
|
{
|
|
my $self = shift ;
|
|
my $key = shift ;
|
|
my $value = undef ;
|
|
$self->db_get($key, $value) ;
|
|
|
|
return $value ;
|
|
}
|
|
|
|
*CLEAR = \&BerkeleyDB::_tiedHash::CLEAR ;
|
|
*FIRSTKEY = \&BerkeleyDB::_tiedHash::FIRSTKEY ;
|
|
*NEXTKEY = \&BerkeleyDB::_tiedHash::NEXTKEY ;
|
|
|
|
sub EXTEND {} # don't do anything with EXTEND
|
|
|
|
|
|
sub SHIFT
|
|
{
|
|
my $self = shift;
|
|
my ($key, $value) = (0, 0) ;
|
|
my $cursor = $self->_db_write_cursor() ;
|
|
return undef if $cursor->c_get($key, $value, BerkeleyDB::DB_FIRST()) != 0 ;
|
|
return undef if $cursor->c_del() != 0 ;
|
|
|
|
return $value ;
|
|
}
|
|
|
|
|
|
sub UNSHIFT
|
|
{
|
|
my $self = shift;
|
|
if (@_)
|
|
{
|
|
my ($key, $value) = (0, 0) ;
|
|
my $cursor = $self->_db_write_cursor() ;
|
|
my $status = $cursor->c_get($key, $value, BerkeleyDB::DB_FIRST()) ;
|
|
if ($status == 0)
|
|
{
|
|
foreach $value (reverse @_)
|
|
{
|
|
$key = 0 ;
|
|
$cursor->c_put($key, $value, BerkeleyDB::DB_BEFORE()) ;
|
|
}
|
|
}
|
|
elsif ($status == BerkeleyDB::DB_NOTFOUND())
|
|
{
|
|
$key = 0 ;
|
|
foreach $value (@_)
|
|
{
|
|
$self->db_put($key++, $value) ;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub PUSH
|
|
{
|
|
my $self = shift;
|
|
if (@_)
|
|
{
|
|
my ($key, $value) = (-1, 0) ;
|
|
my $cursor = $self->_db_write_cursor() ;
|
|
my $status = $cursor->c_get($key, $value, BerkeleyDB::DB_LAST()) ;
|
|
if ($status == 0 || $status == BerkeleyDB::DB_NOTFOUND())
|
|
{
|
|
$key = -1 if $status != 0 and $self->type != BerkeleyDB::DB_RECNO() ;
|
|
foreach $value (@_)
|
|
{
|
|
++ $key ;
|
|
$status = $self->db_put($key, $value) ;
|
|
}
|
|
}
|
|
|
|
# can use this when DB_APPEND is fixed.
|
|
# foreach $value (@_)
|
|
# {
|
|
# my $status = $cursor->c_put($key, $value, BerkeleyDB::DB_AFTER()) ;
|
|
#print "[$status]\n" ;
|
|
# }
|
|
}
|
|
}
|
|
|
|
sub POP
|
|
{
|
|
my $self = shift;
|
|
my ($key, $value) = (0, 0) ;
|
|
my $cursor = $self->_db_write_cursor() ;
|
|
return undef if $cursor->c_get($key, $value, BerkeleyDB::DB_LAST()) != 0 ;
|
|
return undef if $cursor->c_del() != 0 ;
|
|
|
|
return $value ;
|
|
}
|
|
|
|
sub SPLICE
|
|
{
|
|
my $self = shift;
|
|
croak "SPLICE is not implemented yet" ;
|
|
}
|
|
|
|
*shift = \&SHIFT ;
|
|
*unshift = \&UNSHIFT ;
|
|
*push = \&PUSH ;
|
|
*pop = \&POP ;
|
|
*clear = \&CLEAR ;
|
|
*length = \&FETCHSIZE ;
|
|
|
|
sub STORESIZE
|
|
{
|
|
croak "STORESIZE is not implemented yet" ;
|
|
#print "STORESIZE @_\n" ;
|
|
# my $self = shift;
|
|
# my $length = shift ;
|
|
# my $current_length = $self->FETCHSIZE() ;
|
|
#print "length is $current_length\n";
|
|
#
|
|
# if ($length < $current_length) {
|
|
#print "Make smaller $length < $current_length\n" ;
|
|
# my $key ;
|
|
# for ($key = $current_length - 1 ; $key >= $length ; -- $key)
|
|
# { $self->db_del($key) }
|
|
# }
|
|
# elsif ($length > $current_length) {
|
|
#print "Make larger $length > $current_length\n" ;
|
|
# $self->db_put($length-1, "") ;
|
|
# }
|
|
# else { print "stay the same\n" }
|
|
|
|
}
|
|
|
|
|
|
|
|
#sub DESTROY
|
|
#{
|
|
# my $self = shift ;
|
|
# print "BerkeleyDB::_tieArray::DESTROY\n" ;
|
|
#}
|
|
|
|
|
|
package BerkeleyDB::Common ;
|
|
|
|
|
|
use Carp ;
|
|
|
|
|
|
sub STORABLE_freeze
|
|
{
|
|
my $type = ref shift;
|
|
croak "Cannot freeze $type object\n";
|
|
}
|
|
|
|
sub STORABLE_thaw
|
|
{
|
|
my $type = ref shift;
|
|
croak "Cannot thaw $type object\n";
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
$self->_DESTROY() ;
|
|
}
|
|
sub Env
|
|
{
|
|
my $self = shift ;
|
|
$self->[1] ;
|
|
}
|
|
|
|
sub Txn
|
|
{
|
|
my $self = shift ;
|
|
my $txn = shift ;
|
|
#print "BerkeleyDB::Common::Txn db [$self] txn [$txn]\n" ;
|
|
if ($txn) {
|
|
$self->_Txn($txn) ;
|
|
push @{ $txn }, $self ;
|
|
}
|
|
else {
|
|
$self->_Txn() ;
|
|
}
|
|
#print "end BerkeleyDB::Common::Txn \n";
|
|
}
|
|
|
|
|
|
sub get_dup
|
|
{
|
|
croak "Usage: \$db->get_dup(key [,flag])\n"
|
|
unless @_ == 2 or @_ == 3 ;
|
|
|
|
my $db = shift ;
|
|
my $key = shift ;
|
|
my $flag = shift ;
|
|
my $value = 0 ;
|
|
my $origkey = $key ;
|
|
my $wantarray = wantarray ;
|
|
my %values = () ;
|
|
my @values = () ;
|
|
my $counter = 0 ;
|
|
my $status = 0 ;
|
|
my $cursor = $db->db_cursor() ;
|
|
|
|
# iterate through the database until either EOF ($status == 0)
|
|
# or a different key is encountered ($key ne $origkey).
|
|
for ($status = $cursor->c_get($key, $value, BerkeleyDB::DB_SET()) ;
|
|
$status == 0 and $key eq $origkey ;
|
|
$status = $cursor->c_get($key, $value, BerkeleyDB::DB_NEXT()) ) {
|
|
# save the value or count number of matches
|
|
if ($wantarray) {
|
|
if ($flag)
|
|
{ ++ $values{$value} }
|
|
else
|
|
{ push (@values, $value) }
|
|
}
|
|
else
|
|
{ ++ $counter }
|
|
|
|
}
|
|
|
|
return ($wantarray ? ($flag ? %values : @values) : $counter) ;
|
|
}
|
|
|
|
sub db_cursor
|
|
{
|
|
my $db = shift ;
|
|
my ($addr) = $db->_db_cursor(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $db] , "BerkeleyDB::Cursor" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub _db_write_cursor
|
|
{
|
|
my $db = shift ;
|
|
my ($addr) = $db->__db_write_cursor(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $db] , "BerkeleyDB::Cursor" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub db_join
|
|
{
|
|
croak 'Usage: $db->BerkeleyDB::db_join([cursors], flags=0)'
|
|
if @_ < 2 || @_ > 3 ;
|
|
my $db = shift ;
|
|
croak 'db_join: first parameter is not an array reference'
|
|
if ! ref $_[0] || ref $_[0] ne 'ARRAY';
|
|
my ($addr) = $db->_db_join(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $db, $_[0]] , "BerkeleyDB::Cursor" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
package BerkeleyDB::Cursor ;
|
|
|
|
sub c_close
|
|
{
|
|
my $cursor = shift ;
|
|
$cursor->[1] = "" ;
|
|
return $cursor->_c_close() ;
|
|
}
|
|
|
|
sub c_dup
|
|
{
|
|
my $cursor = shift ;
|
|
my ($addr) = $cursor->_c_dup(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $cursor->[1]] , "BerkeleyDB::Cursor" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub c_get_db_stream
|
|
{
|
|
my $cursor = shift ;
|
|
|
|
my $addr = $cursor->_c_get_db_stream(@_);
|
|
my $obj ;
|
|
$obj = bless [$addr, $cursor] , "BerkeleyDB::DbStream" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
sub db_stream
|
|
{
|
|
my $db = shift ;
|
|
my ($addr) = $db->_db_stream(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $db] , "BerkeleyDB::DbStream" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
#sub gdbs
|
|
#{
|
|
# my $cursor = shift ;
|
|
#
|
|
# my $k = '';
|
|
# my $v = '';
|
|
# $db->partial_set(0,0) ;
|
|
# ok $cursor->c_get($k, $v, DB_FIRST) == 0, "set cursor"
|
|
# or diag "Status is [" . $cursor->status() . "]";
|
|
# $db->partial_clear() ;
|
|
# is $k, "1";
|
|
#}
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
$self->_DESTROY() ;
|
|
}
|
|
|
|
|
|
package BerkeleyDB::TxnMgr ;
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
$self->_DESTROY() ;
|
|
}
|
|
|
|
sub txn_begin
|
|
{
|
|
my $txnmgr = shift ;
|
|
my ($addr) = $txnmgr->_txn_begin(@_) ;
|
|
my $obj ;
|
|
$obj = bless [$addr, $txnmgr] , "BerkeleyDB::Txn" if $addr ;
|
|
return $obj ;
|
|
}
|
|
|
|
package BerkeleyDB::Txn ;
|
|
|
|
sub Txn
|
|
{
|
|
my $self = shift ;
|
|
my $db ;
|
|
# keep a reference to each db in the txn object
|
|
foreach $db (@_) {
|
|
$db->_Txn($self) ;
|
|
push @{ $self}, $db ;
|
|
}
|
|
}
|
|
|
|
sub txn_commit
|
|
{
|
|
my $self = shift ;
|
|
$self->disassociate() ;
|
|
my $status = $self->_txn_commit() ;
|
|
return $status ;
|
|
}
|
|
|
|
sub txn_abort
|
|
{
|
|
my $self = shift ;
|
|
$self->disassociate() ;
|
|
my $status = $self->_txn_abort() ;
|
|
return $status ;
|
|
}
|
|
|
|
sub disassociate
|
|
{
|
|
my $self = shift ;
|
|
my $db ;
|
|
while ( @{ $self } > 2) {
|
|
$db = pop @{ $self } ;
|
|
$db->Txn() ;
|
|
}
|
|
#print "end disassociate\n" ;
|
|
}
|
|
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
|
|
$self->disassociate() ;
|
|
# first close the close the transaction
|
|
$self->_DESTROY() ;
|
|
}
|
|
|
|
package BerkeleyDB::CDS::Lock;
|
|
|
|
use vars qw(%Object %Count);
|
|
use Carp;
|
|
|
|
sub BerkeleyDB::Common::cds_lock
|
|
{
|
|
my $db = shift ;
|
|
|
|
# fatal error if database not opened in CDS mode
|
|
croak("CDS not enabled for this database\n")
|
|
if ! $db->cds_enabled();
|
|
|
|
if ( ! defined $Object{"$db"})
|
|
{
|
|
$Object{"$db"} = $db->_db_write_cursor()
|
|
|| return undef ;
|
|
}
|
|
|
|
++ $Count{"$db"} ;
|
|
|
|
return bless [$db, 1], "BerkeleyDB::CDS::Lock" ;
|
|
}
|
|
|
|
sub cds_unlock
|
|
{
|
|
my $self = shift ;
|
|
my $db = $self->[0] ;
|
|
|
|
if ($self->[1])
|
|
{
|
|
$self->[1] = 0 ;
|
|
-- $Count{"$db"} if $Count{"$db"} > 0 ;
|
|
|
|
if ($Count{"$db"} == 0)
|
|
{
|
|
$Object{"$db"}->c_close() ;
|
|
delete $Object{"$db"};
|
|
delete $Count{"$db"};
|
|
}
|
|
|
|
return 1 ;
|
|
}
|
|
|
|
return undef ;
|
|
}
|
|
|
|
sub DESTROY
|
|
{
|
|
my $self = shift ;
|
|
$self->cds_unlock() ;
|
|
}
|
|
|
|
package BerkeleyDB::Term ;
|
|
|
|
END
|
|
{
|
|
close_everything() ;
|
|
}
|
|
|
|
|
|
package BerkeleyDB ;
|
|
|
|
|
|
|
|
|
|
1;
|
|
__END__
|
|
|
|
|
|
|