diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/BerkeleyDB.pm | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/BerkeleyDB.pm')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/BerkeleyDB.pm | 1833 |
1 files changed, 1833 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/BerkeleyDB.pm b/Master/tlpkg/tlperl/lib/BerkeleyDB.pm new file mode 100755 index 00000000000..8269f8efa93 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/BerkeleyDB.pm @@ -0,0 +1,1833 @@ + +package BerkeleyDB; + + +# Copyright (c) 1997-2010 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__. + +BEGIN { require 5.005 } + +use strict; +use Carp; +use vars qw($VERSION @ISA @EXPORT $AUTOLOAD + $use_XSLoader); + +$VERSION = '0.41'; + +require Exporter; +#require DynaLoader; +require AutoLoader; + +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( + 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_IMMUTABLE_KEY + DB_AUTO_COMMIT + DB_BEFORE + DB_BTREE + DB_BTREEMAGIC + DB_BTREEOLDVER + DB_BTREEVERSION + DB_BUFFER_SMALL + DB_CACHED_COUNTS + DB_CDB_ALLDB + DB_CHECKPOINT + DB_CHKSUM + DB_CHKSUM_SHA1 + DB_CKP_INTERNAL + DB_CLIENT + DB_CL_WRITER + DB_COMMIT + DB_COMPACT_FLAGS + DB_CONSUME + DB_CONSUME_WAIT + DB_CREATE + DB_CURLSN + DB_CURRENT + DB_CURSOR_BULK + DB_CURSOR_TRANSIENT + DB_CXX_NO_EXCEPTIONS + 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_ENCRYPT + DB_ENCRYPT_AES + DB_ENV_APPINIT + DB_ENV_AUTO_COMMIT + DB_ENV_CDB + DB_ENV_CDB_ALLDB + DB_ENV_CREATE + 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_LOCKDOWN + DB_ENV_LOCKING + DB_ENV_LOGGING + DB_ENV_LOG_AUTOREMOVE + DB_ENV_LOG_INMEMORY + DB_ENV_MULTIVERSION + DB_ENV_NOLOCKING + DB_ENV_NOMMAP + DB_ENV_NOPANIC + DB_ENV_NO_OUTPUT_SET + DB_ENV_OPEN_CALLED + DB_ENV_OVERWRITE + DB_ENV_PANIC_OK + 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_NOT_HANDLED + DB_EVENT_NO_SUCH_EVENT + DB_EVENT_PANIC + DB_EVENT_REG_ALIVE + DB_EVENT_REG_PANIC + DB_EVENT_REP_CLIENT + DB_EVENT_REP_ELECTED + DB_EVENT_REP_MASTER + DB_EVENT_REP_NEWMASTER + DB_EVENT_REP_PERM_FAILED + DB_EVENT_REP_STARTUPDONE + DB_EVENT_WRITE_FAILED + DB_EXCL + DB_EXTENT + DB_FAILCHK + DB_FAST_STAT + DB_FCNTL_LOCKING + DB_FILEOPEN + DB_FILE_ID_LEN + DB_FIRST + DB_FIXEDLEN + DB_FLUSH + DB_FORCE + 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_HANDLE_LOCK + DB_HASH + DB_HASHMAGIC + DB_HASHOLDVER + DB_HASHVERSION + DB_IGNORE_LEASE + DB_IMMUTABLE_KEY + DB_INCOMPLETE + DB_INIT_CDB + DB_INIT_LOCK + DB_INIT_LOG + DB_INIT_MPOOL + DB_INIT_REP + DB_INIT_TXN + DB_INORDER + DB_JAVA_CALLBACK + DB_JOINENV + DB_JOIN_ITEM + DB_JOIN_NOSORT + DB_KEYEMPTY + DB_KEYEXIST + DB_KEYFIRST + DB_KEYLAST + DB_LAST + DB_LOCKDOWN + DB_LOCKMAGIC + DB_LOCKVERSION + DB_LOCK_ABORT + 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_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_BUFFER_FULL + DB_LOG_CHKPNT + DB_LOG_COMMIT + DB_LOG_DIRECT + DB_LOG_DISK + DB_LOG_DSYNC + DB_LOG_INMEMORY + DB_LOG_IN_MEMORY + DB_LOG_LOCKED + DB_LOG_NOCOPY + DB_LOG_NOT_DURABLE + DB_LOG_PERM + DB_LOG_RESEND + DB_LOG_SILENT_ERR + DB_LOG_WRNOSYNC + DB_LOG_ZERO + DB_MAX_PAGES + DB_MAX_RECORDS + 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_LOCKED + DB_MUTEX_LOGICAL_LOCK + 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_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_ODDFILESIZE + DB_OK_BTREE + DB_OK_HASH + 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_NAME + DB_REGISTER + DB_REGISTERED + DB_RENAMEMAGIC + DB_RENUMBER + DB_REPFLAGS_MASK + DB_REPMGR_ACKS_ALL + 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_CONNECTED + DB_REPMGR_DISCONNECTED + DB_REPMGR_PEER + DB_REP_ACK_TIMEOUT + DB_REP_ANYWHERE + DB_REP_BULKOVF + DB_REP_CHECKPOINT_DELAY + DB_REP_CLIENT + DB_REP_CONF_BULK + DB_REP_CONF_DELAYCLIENT + 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_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_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_RANGE + DB_SET_RECNO + DB_SET_REG_TIMEOUT + DB_SET_TXN_NOW + DB_SET_TXN_TIMEOUT + DB_SHALLOW_DUP + DB_SNAPSHOT + DB_SPARE_FLAG + DB_STAT_ALL + 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_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_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_CKP + 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_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_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_CHKPOINT + DB_VERB_DEADLOCK + DB_VERB_FILEOPS + DB_VERB_FILEOPS_ALL + 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_TEST + DB_VERB_WAITSFOR + DB_VERIFY + DB_VERIFY_BAD + DB_VERIFY_FATAL + DB_VERIFY_PARTITION + DB_VERSION_MAJOR + DB_VERSION_MINOR + DB_VERSION_MISMATCH + DB_VERSION_PATCH + 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 + ); + +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, + MaxLockers => 0, + MaxLocks => 0, + MaxObjects => 0, + Verbose => 0, + Config => undef, + Encrypt => undef, + SharedMemKey => undef, + ThreadCount => 0, + }, @_) ; + + 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() ; +} + +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, + }, @_) ; + + 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, + }, @_) ; + + 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::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 +{ + 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 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 DESTROY +{ + my $self = shift ; + $self->_DESTROY() ; +} + +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 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() ; + undef $Object{"$db"}; + } + + return 1 ; + } + + return undef ; +} + +sub DESTROY +{ + my $self = shift ; + $self->cds_unlock() ; +} + +package BerkeleyDB::Term ; + +END +{ + close_everything() ; +} + + +package BerkeleyDB ; + + + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; +__END__ + + + |