diff options
Diffstat (limited to 'storage/bdb/perl/BerkeleyDB')
52 files changed, 24265 insertions, 0 deletions
diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pm b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pm new file mode 100644 index 00000000000..c56390ba71f --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pm @@ -0,0 +1,1506 @@ + +package BerkeleyDB; + + +# Copyright (c) 1997-2002 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.004_04 } + +use strict; +use Carp; +use vars qw($VERSION @ISA @EXPORT $AUTOLOAD + $use_XSLoader); + +$VERSION = '0.20'; + +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_AUTO_COMMIT + DB_BEFORE + DB_BROADCAST_EID + DB_BTREE + DB_BTREEMAGIC + DB_BTREEOLDVER + DB_BTREEVERSION + DB_CACHED_COUNTS + DB_CDB_ALLDB + DB_CHECKPOINT + DB_CHKSUM_SHA1 + DB_CLIENT + DB_CL_WRITER + DB_COMMIT + DB_CONSUME + DB_CONSUME_WAIT + DB_CREATE + DB_CURLSN + DB_CURRENT + DB_CXX_NO_EXCEPTIONS + DB_DELETED + DB_DELIMITER + DB_DIRECT + DB_DIRECT_DB + DB_DIRECT_LOG + DB_DIRTY_READ + DB_DONOTINDEX + DB_DUP + DB_DUPCURSOR + DB_DUPSORT + 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_FATAL + DB_ENV_LOCKDOWN + DB_ENV_LOCKING + DB_ENV_LOGGING + DB_ENV_NOLOCKING + DB_ENV_NOMMAP + DB_ENV_NOPANIC + DB_ENV_OPEN_CALLED + DB_ENV_OVERWRITE + DB_ENV_PANIC_OK + DB_ENV_PRIVATE + 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_TXN + DB_ENV_TXN_NOSYNC + DB_ENV_TXN_WRITE_NOSYNC + DB_ENV_USER_ALLOC + DB_ENV_YIELDCPU + DB_EXCL + DB_EXTENT + DB_FAST_STAT + DB_FCNTL_LOCKING + DB_FILE_ID_LEN + DB_FIRST + DB_FIXEDLEN + DB_FLUSH + DB_FORCE + DB_GETREC + DB_GET_BOTH + DB_GET_BOTHC + DB_GET_BOTH_RANGE + DB_GET_RECNO + DB_HANDLE_LOCK + DB_HASH + DB_HASHMAGIC + DB_HASHOLDVER + DB_HASHVERSION + DB_INCOMPLETE + DB_INIT_CDB + DB_INIT_LOCK + DB_INIT_LOG + DB_INIT_MPOOL + DB_INIT_TXN + DB_INVALID_EID + 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_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_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_LOGC_BUF_SIZE + DB_LOGFILEID_INVALID + DB_LOGMAGIC + DB_LOGOLDVER + DB_LOGVERSION + DB_LOG_DISK + DB_LOG_LOCKED + DB_LOG_SILENT_ERR + DB_MAX_PAGES + DB_MAX_RECORDS + DB_MPOOL_CLEAN + DB_MPOOL_CREATE + DB_MPOOL_DIRTY + DB_MPOOL_DISCARD + DB_MPOOL_EXTENT + DB_MPOOL_LAST + DB_MPOOL_NEW + DB_MPOOL_NEW_GROUP + DB_MPOOL_PRIVATE + DB_MULTIPLE + DB_MULTIPLE_KEY + DB_MUTEXDEBUG + DB_MUTEXLOCKS + 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_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_PAD + DB_PAGEYIELD + DB_PAGE_LOCK + DB_PAGE_NOTFOUND + DB_PANIC_ENVIRONMENT + DB_PERMANENT + DB_POSITION + DB_POSITIONI + DB_PREV + DB_PREV_NODUP + DB_PRINTABLE + DB_PRIORITY_DEFAULT + DB_PRIORITY_HIGH + DB_PRIORITY_LOW + 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_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_REGISTERED + DB_RENAMEMAGIC + DB_RENUMBER + DB_REP_CLIENT + DB_REP_DUPMASTER + DB_REP_HOLDELECTION + DB_REP_LOGSONLY + DB_REP_MASTER + DB_REP_NEWMASTER + DB_REP_NEWSITE + DB_REP_OUTDATED + DB_REP_PERMANENT + DB_REP_UNAVAIL + DB_REVSPLITOFF + DB_RMW + DB_RPC_SERVERPROG + DB_RPC_SERVERVERS + DB_RUNRECOVERY + DB_SALVAGE + DB_SECONDARY_BAD + DB_SEQUENTIAL + DB_SET + DB_SET_LOCK_TIMEOUT + DB_SET_RANGE + DB_SET_RECNO + DB_SET_TXN_NOW + DB_SET_TXN_TIMEOUT + DB_SNAPSHOT + DB_STAT_CLEAR + 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_POSTEXTDELETE + DB_TEST_POSTEXTOPEN + DB_TEST_POSTEXTUNLINK + DB_TEST_POSTLOG + DB_TEST_POSTLOGMETA + DB_TEST_POSTOPEN + DB_TEST_POSTRENAME + DB_TEST_POSTSYNC + DB_TEST_PREDESTROY + DB_TEST_PREEXTDELETE + DB_TEST_PREEXTOPEN + DB_TEST_PREEXTUNLINK + DB_TEST_PREOPEN + DB_TEST_PRERENAME + DB_TEST_SUBDB_LOCKS + DB_THREAD + DB_TIMEOUT + DB_TRUNCATE + DB_TXNMAGIC + DB_TXNVERSION + DB_TXN_ABORT + DB_TXN_APPLY + DB_TXN_BACKWARD_ALLOC + DB_TXN_BACKWARD_ROLL + DB_TXN_CKP + DB_TXN_FORWARD_ROLL + DB_TXN_GETPGNOS + 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_NOWAIT + DB_TXN_OPENFILES + DB_TXN_POPENFILES + DB_TXN_PRINT + DB_TXN_REDO + DB_TXN_SYNC + DB_TXN_UNDO + DB_TXN_WRITE_NOSYNC + DB_UNKNOWN + DB_UNRESOLVED_CHILD + DB_UPDATE_SECONDARY + DB_UPGRADE + DB_USE_ENVIRON + DB_USE_ENVIRON_ROOT + DB_VERB_CHKPOINT + DB_VERB_DEADLOCK + DB_VERB_RECOVERY + DB_VERB_REPLICATION + DB_VERB_WAITSFOR + DB_VERIFY + DB_VERIFY_BAD + DB_VERIFY_FATAL + DB_VERSION_MAJOR + DB_VERSION_MINOR + DB_VERSION_PATCH + DB_VERSION_STRING + DB_VRFY_FLAGMASK + DB_WRITECURSOR + DB_WRITELOCK + DB_WRITEOPEN + DB_WRNOSYNC + DB_XA_CREATE + DB_XIDDATASIZE + DB_YIELDCPU + ); + +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) { + %options = @rest ; + } + + 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 ; +} + +use UNIVERSAL qw( isa ) ; + +sub env_remove +{ + # Usage: + # + # $env = new BerkeleyDB::Env + # [ -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, + }, @_) ; + + croak("Must specify a filename") + if ! defined $got->{Filename} ; + + croak("Env not of type BerkeleyDB::Env") + if defined $got->{Env} and ! 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, + }, @_) ; + + croak("Env not of type BerkeleyDB::Env") + if defined $got->{Env} and ! 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 ! isa($got->{Env},'BerkeleyDB::Env'); + + croak("Must specify a filename") + if ! defined $got->{Filename} ; + + return _db_verify($got); +} + +package BerkeleyDB::Env ; + +use UNIVERSAL qw( isa ) ; +use Carp ; +use vars qw( %valid_config_keys ) ; + +sub isaFilehandle +{ + my $fh = shift ; + + return ((isa($fh,'GLOB') or 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 ] + # ; + + my $pkg = shift ; + my $got = BerkeleyDB::ParseParameters({ + Home => undef, + Server => undef, + Mode => 0666, + ErrFile => undef, + ErrPrefix => undef, + Flags => 0, + SetFlags => 0, + Cachesize => 0, + LockDetect => 0, + Verbose => 0, + Config => undef, + }, @_) ; + + if (defined $got->{ErrFile}) { + croak("ErrFile parameter must be a file name") + if ref $got->{ErrFile} ; + #if (!isaFilehandle($got->{ErrFile})) { + # my $handle = new IO::File ">$got->{ErrFile}" +# or croak "Cannot open file $got->{ErrFile}: $!\n" ; +# $got->{ErrFile} = $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->{"Config"} = pack("p*", @BerkeleyDB::a, undef) + if @BerkeleyDB::a ; + } + + my ($addr) = _db_appinit($pkg, $got) ; + 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 qw( isa ) ; +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, + + # 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 ! 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 a hash") + if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; + + 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 qw( isa ) ; +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, + + # Btree specific + Minkey => 0, + Compare => undef, + DupCompare => undef, + Prefix => 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 a hash") + if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; + + 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 qw( isa ) ; +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, + + # 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 ! 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/ ; + + croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}") + if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ; + + + $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 qw( isa ) ; +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, + + # 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 ! 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/ ; + + croak("ArrayBase can only be 0 or 1, parsed $got->{ArrayBase}") + if $got->{ArrayBase} != 1 and $got->{ArrayBase} != 0 ; + + $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 qw( isa ) ; +## 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 qw( isa ) ; +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, + + }, @_) ; + + 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 a hash") + if defined $got->{Tie} and $got->{Tie} !~ /HASH/ ; + + 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_cursor() ; + while ($cursor->c_get($key, $value, BerkeleyDB::DB_PREV()) == 0) + { $cursor->c_del() } + #1 while $cursor->c_del() == 0 ; + # cursor will self-destruct +} + +#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_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_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_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_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_join +{ + croak 'Usage: $db->BerkeleyDB::Common::db_join([cursors], flags=0)' + if @_ < 2 || @_ > 3 ; + my $db = shift ; + 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::Term ; + +END +{ + close_everything() ; +} + + +package BerkeleyDB ; + + + +# Autoload methods go after =cut, and are processed by the autosplit program. + +1; +__END__ + + diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod new file mode 100644 index 00000000000..60f30e2abfb --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod @@ -0,0 +1,1792 @@ +=head1 NAME + +BerkeleyDB - Perl extension for Berkeley DB version 2, 3 or 4 + +=head1 SYNOPSIS + + use BerkeleyDB; + + $env = new BerkeleyDB::Env [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Hash', [OPTIONS] ; + $db = new BerkeleyDB::Hash [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Btree', [OPTIONS] ; + $db = new BerkeleyDB::Btree [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Recno', [OPTIONS] ; + $db = new BerkeleyDB::Recno [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Queue', [OPTIONS] ; + $db = new BerkeleyDB::Queue [OPTIONS] ; + + $db = new BerkeleyDB::Unknown [OPTIONS] ; + + $status = BerkeleyDB::db_remove [OPTIONS] + $status = BerkeleyDB::db_rename [OPTIONS] + $status = BerkeleyDB::db_verify [OPTIONS] + + $hash{$key} = $value ; + $value = $hash{$key} ; + each %hash ; + keys %hash ; + values %hash ; + + $status = $db->db_get() + $status = $db->db_put() ; + $status = $db->db_del() ; + $status = $db->db_sync() ; + $status = $db->db_close() ; + $status = $db->db_close() ; + $status = $db->db_pget() + $hash_ref = $db->db_stat() ; + $status = $db->db_key_range(); + $type = $db->type() ; + $status = $db->status() ; + $boolean = $db->byteswapped() ; + $status = $db->truncate($count) ; + + ($flag, $old_offset, $old_length) = $db->partial_set($offset, $length) ; + ($flag, $old_offset, $old_length) = $db->partial_clear() ; + + $cursor = $db->db_cursor([$flags]) ; + $newcursor = $cursor->c_dup([$flags]); + $status = $cursor->c_get() ; + $status = $cursor->c_put() ; + $status = $cursor->c_del() ; + $status = $cursor->c_count() ; + $status = $cursor->c_pget() ; + $status = $cursor->status() ; + $status = $cursor->c_close() ; + + $cursor = $db->db_join() ; + $status = $cursor->c_get() ; + $status = $cursor->c_close() ; + + $status = $env->txn_checkpoint() + $hash_ref = $env->txn_stat() + $status = $env->setmutexlocks() + $status = $env->set_flags() + + $txn = $env->txn_begin() ; + $db->Txn($txn); + $txn->Txn($db1, $db2,...); + $status = $txn->txn_prepare() + $status = $txn->txn_commit() + $status = $txn->txn_abort() + $status = $txn->txn_id() + $status = $txn->txn_discard() + + $status = $env->set_lg_dir(); + $status = $env->set_lg_bsize(); + $status = $env->set_lg_max(); + + $status = $env->set_data_dir() ; + $status = $env->set_tmp_dir() ; + $status = $env->set_verbose() ; + + $BerkeleyDB::Error + $BerkeleyDB::db_version + + # DBM Filters + $old_filter = $db->filter_store_key ( sub { ... } ) ; + $old_filter = $db->filter_store_value( sub { ... } ) ; + $old_filter = $db->filter_fetch_key ( sub { ... } ) ; + $old_filter = $db->filter_fetch_value( sub { ... } ) ; + + # deprecated, but supported + $txn_mgr = $env->TxnMgr(); + $status = $txn_mgr->txn_checkpoint() + $hash_ref = $txn_mgr->txn_stat() + $txn = $txn_mgr->txn_begin() ; + +=head1 DESCRIPTION + +B<NOTE: This document is still under construction. Expect it to be +incomplete in places.> + +This Perl module provides an interface to most of the functionality +available in Berkeley DB versions 2, 3 and 4. In general it is safe to assume +that the interface provided here to be identical to the Berkeley DB +interface. The main changes have been to make the Berkeley DB API work +in a Perl way. Note that if you are using Berkeley DB 2.x, the new +features available in Berkeley DB 3.x or DB 4.x are not available via +this module. + +The reader is expected to be familiar with the Berkeley DB +documentation. Where the interface provided here is identical to the +Berkeley DB library and the... TODO + +The B<db_appinit>, B<db_cursor>, B<db_open> and B<db_txn> man pages are +particularly relevant. + +The interface to Berkeley DB is implemented with a number of Perl +classes. + +=head1 ENV CLASS + +The B<BerkeleyDB::Env> class provides an interface to the Berkeley DB +function B<db_appinit> in Berkeley DB 2.x or B<db_env_create> and +B<DBENV-E<gt>open> in Berkeley DB 3.x/4.x. Its purpose is to initialise a +number of sub-systems that can then be used in a consistent way in all +the databases you make use of the environment. + +If you don't intend using transactions, locking or logging, then you +shouldn't need to make use of B<BerkeleyDB::Env>. + +=head2 Synopsis + + $env = new BerkeleyDB::Env + [ -Home => $path, ] + [ -Server => $name, ] + [ -CacheSize => $number, ] + [ -Config => { name => value, name => value }, ] + [ -ErrFile => filename, ] + [ -ErrPrefix => "string", ] + [ -Flags => number, ] + [ -SetFlags => bitmask, ] + [ -LockDetect => number, ] + [ -Verbose => boolean, ] + +=over 5 + +All the parameters to the BerkeleyDB::Env constructor are optional. + +=item -Home + +If present, this parameter should point to an existing directory. Any +files that I<aren't> specified with an absolute path in the sub-systems +that are initialised by the BerkeleyDB::Env class will be assumed to +live in the B<Home> directory. + +For example, in the code fragment below the database "fred.db" will be +opened in the directory "/home/databases" because it was specified as a +relative path, but "joe.db" will be opened in "/other" because it was +part of an absolute path. + + $env = new BerkeleyDB::Env + -Home => "/home/databases" + ... + + $db1 = new BerkeleyDB::Hash + -Filename = "fred.db", + -Env => $env + ... + + $db2 = new BerkeleyDB::Hash + -Filename = "/other/joe.db", + -Env => $env + ... + +=item -Server + +If present, this parameter should be the hostname of a server that is running +the Berkeley DB RPC server. All databases will be accessed via the RPC server. + +=item -Cachesize + +If present, this parameter sets the size of the environments shared memory +buffer pool. + +=item -Config + +This is a variation on the C<-Home> parameter, but it allows finer +control of where specific types of files will be stored. + +The parameter expects a reference to a hash. Valid keys are: +B<DB_DATA_DIR>, B<DB_LOG_DIR> and B<DB_TMP_DIR> + +The code below shows an example of how it can be used. + + $env = new BerkeleyDB::Env + -Config => { DB_DATA_DIR => "/home/databases", + DB_LOG_DIR => "/home/logs", + DB_TMP_DIR => "/home/tmp" + } + ... + +=item -ErrFile + +Expects a filenme. Any errors generated internally by Berkeley DB will +be logged to this file. + +=item -ErrPrefix + +Allows a prefix to be added to the error messages before they are sent +to B<-ErrFile>. + +=item -Flags + +The B<Flags> parameter specifies both which sub-systems to initialise, +as well as a number of environment-wide options. +See the Berkeley DB documentation for more details of these options. + +Any of the following can be specified by OR'ing them: + +B<DB_CREATE> + +If any of the files specified do not already exist, create them. + +B<DB_INIT_CDB> + +Initialise the Concurrent Access Methods + +B<DB_INIT_LOCK> + +Initialise the Locking sub-system. + +B<DB_INIT_LOG> + +Initialise the Logging sub-system. + +B<DB_INIT_MPOOL> + +Initialise the ... + +B<DB_INIT_TXN> + +Initialise the ... + +B<DB_MPOOL_PRIVATE> + +Initialise the ... + +B<DB_INIT_MPOOL> is also specified. + +Initialise the ... + +B<DB_NOMMAP> + +Initialise the ... + +B<DB_RECOVER> + + + +B<DB_RECOVER_FATAL> + +B<DB_THREAD> + +B<DB_TXN_NOSYNC> + +B<DB_USE_ENVIRON> + +B<DB_USE_ENVIRON_ROOT> + +=item -SetFlags + +Calls ENV->set_flags with the supplied bitmask. Use this when you need to make +use of DB_ENV->set_flags before DB_ENV->open is called. + +Only valid when Berkeley DB 3.x or better is used. + +=item -LockDetect + +Specifies what to do when a lock conflict occurs. The value should be one of + +B<DB_LOCK_DEFAULT> + +B<DB_LOCK_OLDEST> + +B<DB_LOCK_RANDOM> + +B<DB_LOCK_YOUNGEST> + +=item -Verbose + +Add extra debugging information to the messages sent to B<-ErrFile>. + +=back + +=head2 Methods + +The environment class has the following methods: + +=over 5 + +=item $env->errPrefix("string") ; + +This method is identical to the B<-ErrPrefix> flag. It allows the +error prefix string to be changed dynamically. + +=item $env->set_flags(bitmask, 1|0); + +=item $txn = $env->TxnMgr() + +Constructor for creating a B<TxnMgr> object. +See L<"TRANSACTIONS"> for more details of using transactions. + +This method is deprecated. Access the transaction methods using the B<txn_> +methods below from the environment object directly. + +=item $env->txn_begin() + +TODO + +=item $env->txn_stat() + +TODO + +=item $env->txn_checkpoint() + +TODO + +=item $env->status() + +Returns the status of the last BerkeleyDB::Env method. + +=item $env->setmutexlocks() + +Only available in Berkeley Db 3.0 or greater. Calls +B<db_env_set_mutexlocks> when used with Berkeley DB 3.1.x. When used with +Berkeley DB 3.0 or 3.2 and better it calls B<DBENV-E<gt>set_mutexlocks>. + +=back + +=head2 Examples + +TODO. + +=head1 Global Classes + + $status = BerkeleyDB::db_remove [OPTIONS] + $status = BerkeleyDB::db_rename [OPTIONS] + $status = BerkeleyDB::db_verify [OPTIONS] + +=head1 THE DATABASE CLASSES + +B<BerkeleyDB> supports the following database formats: + +=over 5 + +=item B<BerkeleyDB::Hash> + +This database type allows arbitrary key/value pairs to be stored in data +files. This is equivalent to the functionality provided by other +hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. Remember though, +the files created using B<BerkeleyDB::Hash> are not compatible with any +of the other packages mentioned. + +A default hashing algorithm, which will be adequate for most applications, +is built into BerkeleyDB. If you do need to use your own hashing algorithm +it is possible to write your own in Perl and have B<BerkeleyDB> use +it instead. + +=item B<BerkeleyDB::Btree> + +The Btree format allows arbitrary key/value pairs to be stored in a +B+tree. + +As with the B<BerkeleyDB::Hash> format, it is possible to provide a +user defined Perl routine to perform the comparison of keys. By default, +though, the keys are stored in lexical order. + +=item B<BerkeleyDB::Recno> + +TODO. + + +=item B<BerkeleyDB::Queue> + +TODO. + +=item B<BerkeleyDB::Unknown> + +This isn't a database format at all. It is used when you want to open an +existing Berkeley DB database without having to know what type is it. + +=back + + +Each of the database formats described above is accessed via a +corresponding B<BerkeleyDB> class. These will be described in turn in +the next sections. + +=head1 BerkeleyDB::Hash + +Equivalent to calling B<db_open> with type B<DB_HASH> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_HASH> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Hash + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Hash specific + [ -Ffactor => number,] + [ -Nelem => number,] + [ -Hash => code reference,] + [ -DupCompare => code reference,] + +and this + + [$db =] tie %hash, 'BerkeleyDB::Hash', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Hash specific + [ -Ffactor => number,] + [ -Nelem => number,] + [ -Hash => code reference,] + [ -DupCompare => code reference,] + + +When the "tie" interface is used, reading from and writing to the database +is achieved via the tied hash. In this case the database operates like +a Perl associative array that happens to be stored on disk. + +In addition to the high-level tied hash interface, it is possible to +make use of the underlying methods provided by Berkeley DB + +=head2 Options + +In addition to the standard set of options (see L<COMMON OPTIONS>) +B<BerkeleyDB::Hash> supports these options: + +=over 5 + +=item -Property + +Used to specify extra flags when opening a database. The following +flags may be specified by logically OR'ing together one or more of the +following values: + +B<DB_DUP> + +When creating a new database, this flag enables the storing of duplicate +keys in the database. If B<DB_DUPSORT> is not specified as well, the +duplicates are stored in the order they are created in the database. + +B<DB_DUPSORT> + +Enables the sorting of duplicate keys in the database. Ignored if +B<DB_DUP> isn't also specified. + +=item -Ffactor + +=item -Nelem + +See the Berkeley DB documentation for details of these options. + +=item -Hash + +Allows you to provide a user defined hash function. If not specified, +a default hash function is used. Here is a template for a user-defined +hash function + + sub hash + { + my ($data) = shift ; + ... + # return the hash value for $data + return $hash ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Hash => \&hash, + ... + +See L<""> for an example. + +=item -DupCompare + +Used in conjunction with the B<DB_DUPOSRT> flag. + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Property => DB_DUP|DB_DUPSORT, + -DupCompare => \&compare, + ... + +=back + + +=head2 Methods + +B<BerkeleyDB::Hash> only supports the standard database methods. +See L<COMMON DATABASE METHODS>. + +=head2 A Simple Tied Hash Example + + use strict ; + use BerkeleyDB ; + use vars qw( %h $k $v ) ; + + my $filename = "fruit" ; + unlink $filename ; + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $h{"apple"} = "red" ; + $h{"orange"} = "orange" ; + $h{"banana"} = "yellow" ; + $h{"tomato"} = "red" ; + + # Check for existence of a key + print "Banana Exists\n\n" if $h{"banana"} ; + + # Delete a key/value pair. + delete $h{"apple"} ; + + # print the contents of the file + while (($k, $v) = each %h) + { print "$k -> $v\n" } + + untie %h ; + +here is the output: + + Banana Exists + + orange -> orange + tomato -> red + banana -> yellow + +Note that the like ordinary associative arrays, the order of the keys +retrieved from a Hash database are in an apparently random order. + +=head2 Another Simple Hash Example + +Do the same as the previous example but not using tie. + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("apple", "red") ; + $db->db_put("orange", "orange") ; + $db->db_put("banana", "yellow") ; + $db->db_put("tomato", "red") ; + + # Check for existence of a key + print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0; + + # Delete a key/value pair. + $db->db_del("apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + +=head2 Duplicate keys + +The code below is a variation on the examples above. This time the hash has +been inverted. The key this time is colour and the value is the fruit name. +The B<DB_DUP> flag has been specified to allow duplicates. + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + +here is the output: + + orange -> orange + yellow -> banana + red -> apple + red -> tomato + green -> banana + green -> apple + +=head2 Sorting Duplicate Keys + +In the previous example, when there were duplicate keys, the values are +sorted in the order they are stored in. The code below is +identical to the previous example except the B<DB_DUPSORT> flag is +specified. + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP | DB_DUPSORT + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + +Notice that in the output below the duplicate values are sorted. + + orange -> orange + yellow -> banana + red -> apple + red -> tomato + green -> apple + green -> banana + +=head2 Custom Sorting Duplicate Keys + +Another variation + +TODO + +=head2 Changing the hash + +TODO + +=head2 Using db_stat + +TODO + +=head1 BerkeleyDB::Btree + +Equivalent to calling B<db_open> with type B<DB_BTREE> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_BTREE> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + + $db = new BerkeleyDB::Btree + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Btree specific + [ -Minkey => number,] + [ -Compare => code reference,] + [ -DupCompare => code reference,] + [ -Prefix => code reference,] + +and this + + [$db =] tie %hash, 'BerkeleyDB::Btree', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Btree specific + [ -Minkey => number,] + [ -Compare => code reference,] + [ -DupCompare => code reference,] + [ -Prefix => code reference,] + +=head2 Options + +In addition to the standard set of options (see L<COMMON OPTIONS>) +B<BerkeleyDB::Btree> supports these options: + +=over 5 + +=item -Property + +Used to specify extra flags when opening a database. The following +flags may be specified by logically OR'ing together one or more of the +following values: + +B<DB_DUP> + +When creating a new database, this flag enables the storing of duplicate +keys in the database. If B<DB_DUPSORT> is not specified as well, the +duplicates are stored in the order they are created in the database. + +B<DB_DUPSORT> + +Enables the sorting of duplicate keys in the database. Ignored if +B<DB_DUP> isn't also specified. + +=item Minkey + +TODO + +=item Compare + +Allow you to override the default sort order used in the database. See +L<"Changing the sort order"> for an example. + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Compare => \&compare, + ... + +=item Prefix + + sub prefix + { + my ($key, $key2) = @_ ; + ... + # return number of bytes of $key2 which are + # necessary to determine that it is greater than $key1 + return $bytes ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Prefix => \&prefix, + ... +=item DupCompare + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -DupCompare => \&compare, + ... + +=back + +=head2 Methods + +B<BerkeleyDB::Btree> supports the following database methods. +See also L<COMMON DATABASE METHODS>. + +All the methods below return 0 to indicate success. + +=over 5 + +=item $status = $db->db_key_range($key, $less, $equal, $greater [, $flags]) + +Given a key, C<$key>, this method returns the proportion of keys less than +C<$key> in C<$less>, the proportion equal to C<$key> in C<$equal> and the +proportion greater than C<$key> in C<$greater>. + +The proportion is returned as a double in the range 0.0 to 1.0. + +=back + +=head2 A Simple Btree Example + +The code below is a simple example of using a btree database. + + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; + +Here is the output from the code above. The keys have been sorted using +Berkeley DB's default sorting algorithm. + + Smith + Wall + mouse + + +=head2 Changing the sort order + +It is possible to supply your own sorting algorithm if the one that Berkeley +DB used isn't suitable. The code below is identical to the previous example +except for the case insensitive compare function. + + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE, + -Compare => sub { lc $_[0] cmp lc $_[1] } + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; + +Here is the output from the code above. + + mouse + Smith + Wall + +There are a few point to bear in mind if you want to change the +ordering in a BTREE database: + +=over 5 + +=item 1. + +The new compare function must be specified when you create the database. + +=item 2. + +You cannot change the ordering once the database has been created. Thus +you must use the same compare function every time you access the +database. + +=back + +=head2 Using db_stat + +TODO + +=head1 BerkeleyDB::Recno + +Equivalent to calling B<db_open> with type B<DB_RECNO> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_RECNO> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Recno + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Recno specific + [ -Delim => byte,] + [ -Len => number,] + [ -Pad => byte,] + [ -Source => filename,] + +and this + + [$db =] tie @arry, 'BerkeleyDB::Recno', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Recno specific + [ -Delim => byte,] + [ -Len => number,] + [ -Pad => byte,] + [ -Source => filename,] + +=head2 A Recno Example + +Here is a simple example that uses RECNO (if you are using a version +of Perl earlier than 5.004_57 this example won't work -- see +L<Extra RECNO Methods> for a workaround). + + use strict ; + use BerkeleyDB ; + + my $filename = "text" ; + unlink $filename ; + + my @h ; + tie @h, 'BerkeleyDB::Recno', + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_RENUMBER + or die "Cannot open $filename: $!\n" ; + + # Add a few key/value pairs to the file + $h[0] = "orange" ; + $h[1] = "blue" ; + $h[2] = "yellow" ; + + push @h, "green", "black" ; + + my $elements = scalar @h ; + print "The array contains $elements entries\n" ; + + my $last = pop @h ; + print "popped $last\n" ; + + unshift @h, "white" ; + my $first = shift @h ; + print "shifted $first\n" ; + + # Check for existence of a key + print "Element 1 Exists with value $h[1]\n" if $h[1] ; + + untie @h ; + +Here is the output from the script: + + The array contains 5 entries + popped black + shifted white + Element 1 Exists with value blue + The last element is green + The 2nd last element is yellow + +=head1 BerkeleyDB::Queue + +Equivalent to calling B<db_create> followed by B<DB-E<gt>open> with +type B<DB_QUEUE> in Berkeley DB 3.x or greater. This database format +isn't available if you use Berkeley DB 2.x. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Queue + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Queue specific + [ -Len => number,] + [ -Pad => byte,] + [ -ExtentSize => number, ] + +and this + + [$db =] tie @arry, 'BerkeleyDB::Queue', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Queue specific + [ -Len => number,] + [ -Pad => byte,] + + +=head1 BerkeleyDB::Unknown + +This class is used to open an existing database. + +Equivalent to calling B<db_open> with type B<DB_UNKNOWN> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_UNKNOWN> in +Berkeley DB 3.x or greater. + +The constructor looks like this: + + $db = new BerkeleyDB::Unknown + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + + +=head2 An example + +=head1 COMMON OPTIONS + +All database access class constructors support the common set of +options defined below. All are optional. + +=over 5 + +=item -Filename + +The database filename. If no filename is specified, a temporary file will +be created and removed once the program terminates. + +=item -Subname + +Specifies the name of the sub-database to open. +This option is only valid if you are using Berkeley DB 3.x or greater. + +=item -Flags + +Specify how the database will be opened/created. The valid flags are: + +B<DB_CREATE> + +Create any underlying files, as necessary. If the files do not already +exist and the B<DB_CREATE> flag is not specified, the call will fail. + +B<DB_NOMMAP> + +Not supported by BerkeleyDB. + +B<DB_RDONLY> + +Opens the database in read-only mode. + +B<DB_THREAD> + +Not supported by BerkeleyDB. + +B<DB_TRUNCATE> + +If the database file already exists, remove all the data before +opening it. + +=item -Mode + +Determines the file protection when the database is created. Defaults +to 0666. + +=item -Cachesize + +=item -Lorder + +=item -Pagesize + +=item -Env + +When working under a Berkeley DB environment, this parameter + +Defaults to no environment. + +=item -Txn + +TODO. + +=back + +=head1 COMMON DATABASE METHODS + +All the database interfaces support the common set of methods defined +below. + +All the methods below return 0 to indicate success. + +=head2 $status = $db->db_get($key, $value [, $flags]) + +Given a key (C<$key>) this method reads the value associated with it +from the database. If it exists, the value read from the database is +returned in the C<$value> parameter. + +The B<$flags> parameter is optional. If present, it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_GET_BOTH> + +When the B<DB_GET_BOTH> flag is specified, B<db_get> checks for the +existence of B<both> the C<$key> B<and> C<$value> in the database. + +=item B<DB_SET_RECNO> + +TODO. + +=back + +In addition, the following value may be set by logically OR'ing it into +the B<$flags> parameter: + +=over 5 + +=item B<DB_RMW> + +TODO + +=back + + +=head2 $status = $db->db_put($key, $value [, $flags]) + +Stores a key/value pair in the database. + +The B<$flags> parameter is optional. If present it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_APPEND> + +This flag is only applicable when accessing a B<BerkeleyDB::Recno> +database. + +TODO. + + +=item B<DB_NOOVERWRITE> + +If this flag is specified and C<$key> already exists in the database, +the call to B<db_put> will return B<DB_KEYEXIST>. + +=back + +=head2 $status = $db->db_del($key [, $flags]) + +Deletes a key/value pair in the database associated with C<$key>. +If duplicate keys are enabled in the database, B<db_del> will delete +B<all> key/value pairs with key C<$key>. + +The B<$flags> parameter is optional and is currently unused. + +=head2 $status = $db->db_sync() + +If any parts of the database are in memory, write them to the database. + +=head2 $cursor = $db->db_cursor([$flags]) + +Creates a cursor object. This is used to access the contents of the +database sequentially. See L<CURSORS> for details of the methods +available when working with cursors. + +The B<$flags> parameter is optional. If present it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_RMW> + +TODO. + +=back + +=head2 ($flag, $old_offset, $old_length) = $db->partial_set($offset, $length) ; + +TODO + +=head2 ($flag, $old_offset, $old_length) = $db->partial_clear() ; + +TODO + +=head2 $db->byteswapped() + +TODO + +=head2 $db->type() + +Returns the type of the database. The possible return code are B<DB_HASH> +for a B<BerkeleyDB::Hash> database, B<DB_BTREE> for a B<BerkeleyDB::Btree> +database and B<DB_RECNO> for a B<BerkeleyDB::Recno> database. This method +is typically used when a database has been opened with +B<BerkeleyDB::Unknown>. + +=item $ref = $db->db_stat() + +Returns a reference to an associative array containing information about +the database. The keys of the associative array correspond directly to the +names of the fields defined in the Berkeley DB documentation. For example, +in the DB documentation, the field B<bt_version> stores the version of the +Btree database. Assuming you called B<db_stat> on a Btree database the +equivalent field would be accessed as follows: + + $version = $ref->{'bt_version'} ; + +If you are using Berkeley DB 3.x or better, this method will work will +all database formats. When DB 2.x is used, it only works with +B<BerkeleyDB::Btree>. + +=head2 $status = $db->status() + +Returns the status of the last C<$db> method called. + +=head2 $status = $db->truncate($count) + +Truncates the datatabase and returns the number or records deleted +in C<$count>. + +=head1 CURSORS + +A cursor is used whenever you want to access the contents of a database +in sequential order. +A cursor object is created with the C<db_cursor> + +A cursor object has the following methods available: + +=head2 $newcursor = $cursor->c_dup($flags) + +Creates a duplicate of C<$cursor>. This method needs Berkeley DB 3.0.x or better. + +The C<$flags> parameter is optional and can take the following value: + +=over 5 + +=item DB_POSITION + +When present this flag will position the new cursor at the same place as the +existing cursor. + +=back + +=head2 $status = $cursor->c_get($key, $value, $flags) + +Reads a key/value pair from the database, returning the data in C<$key> +and C<$value>. The key/value pair actually read is controlled by the +C<$flags> parameter, which can take B<one> of the following values: + +=over 5 + +=item B<DB_FIRST> + +Set the cursor to point to the first key/value pair in the +database. Return the key/value pair in C<$key> and C<$value>. + +=item B<DB_LAST> + +Set the cursor to point to the last key/value pair in the database. Return +the key/value pair in C<$key> and C<$value>. + +=item B<DB_NEXT> + +If the cursor is already pointing to a key/value pair, it will be +incremented to point to the next key/value pair and return its contents. + +If the cursor isn't initialised, B<DB_NEXT> works just like B<DB_FIRST>. + +If the cursor is already positioned at the last key/value pair, B<c_get> +will return B<DB_NOTFOUND>. + +=item B<DB_NEXT_DUP> + +This flag is only valid when duplicate keys have been enabled in +a database. +If the cursor is already pointing to a key/value pair and the key of +the next key/value pair is identical, the cursor will be incremented to +point to it and their contents returned. + +=item B<DB_PREV> + +If the cursor is already pointing to a key/value pair, it will be +decremented to point to the previous key/value pair and return its +contents. + +If the cursor isn't initialised, B<DB_PREV> works just like B<DB_LAST>. + +If the cursor is already positioned at the first key/value pair, B<c_get> +will return B<DB_NOTFOUND>. + +=item B<DB_CURRENT> + +If the cursor has been set to point to a key/value pair, return their +contents. +If the key/value pair referenced by the cursor has been deleted, B<c_get> +will return B<DB_KEYEMPTY>. + +=item B<DB_SET> + +Set the cursor to point to the key/value pair referenced by B<$key> +and return the value in B<$value>. + +=item B<DB_SET_RANGE> + +This flag is a variation on the B<DB_SET> flag. As well as returning +the value, it also returns the key, via B<$key>. +When used with a B<BerkeleyDB::Btree> database the key matched by B<c_get> +will be the shortest key (in length) which is greater than or equal to +the key supplied, via B<$key>. This allows partial key searches. +See ??? for an example of how to use this flag. + +=item B<DB_GET_BOTH> + +Another variation on B<DB_SET>. This one returns both the key and +the value. + +=item B<DB_SET_RECNO> + +TODO. + +=item B<DB_GET_RECNO> + +TODO. + +=back + +In addition, the following value may be set by logically OR'ing it into +the B<$flags> parameter: + +=over 5 + +=item B<DB_RMW> + +TODO. + +=back + +=head2 $status = $cursor->c_put($key, $value, $flags) + +Stores the key/value pair in the database. The position that the data is +stored in the database is controlled by the C<$flags> parameter, which +must take B<one> of the following values: + +=over 5 + +=item B<DB_AFTER> + +When used with a Btree or Hash database, a duplicate of the key referenced +by the current cursor position will be created and the contents of +B<$value> will be associated with it - B<$key> is ignored. +The new key/value pair will be stored immediately after the current +cursor position. +Obviously the database has to have been opened with B<DB_DUP>. + +When used with a Recno ... TODO + + +=item B<DB_BEFORE> + +When used with a Btree or Hash database, a duplicate of the key referenced +by the current cursor position will be created and the contents of +B<$value> will be associated with it - B<$key> is ignored. +The new key/value pair will be stored immediately before the current +cursor position. +Obviously the database has to have been opened with B<DB_DUP>. + +When used with a Recno ... TODO + +=item B<DB_CURRENT> + +If the cursor has been initialised, replace the value of the key/value +pair stored in the database with the contents of B<$value>. + +=item B<DB_KEYFIRST> + +Only valid with a Btree or Hash database. This flag is only really +used when duplicates are enabled in the database and sorted duplicates +haven't been specified. +In this case the key/value pair will be inserted as the first entry in +the duplicates for the particular key. + +=item B<DB_KEYLAST> + +Only valid with a Btree or Hash database. This flag is only really +used when duplicates are enabled in the database and sorted duplicates +haven't been specified. +In this case the key/value pair will be inserted as the last entry in +the duplicates for the particular key. + +=back + +=head2 $status = $cursor->c_del([$flags]) + +This method deletes the key/value pair associated with the current cursor +position. The cursor position will not be changed by this operation, so +any subsequent cursor operation must first initialise the cursor to +point to a valid key/value pair. + +If the key/value pair associated with the cursor have already been +deleted, B<c_del> will return B<DB_KEYEMPTY>. + +The B<$flags> parameter is not used at present. + +=head2 $status = $cursor->c_del($cnt [, $flags]) + +Stores the number of duplicates at the current cursor position in B<$cnt>. + +The B<$flags> parameter is not used at present. This method needs +Berkeley DB 3.1 or better. + +=head2 $status = $cursor->status() + +Returns the status of the last cursor method as a dual type. + +=head2 Cursor Examples + +TODO + +Iterating from first to last, then in reverse. + +examples of each of the flags. + +=head1 JOIN + +Join support for BerkeleyDB is in progress. Watch this space. + +TODO + +=head1 TRANSACTIONS + +TODO. + +=head1 DBM Filters + +A DBM Filter is a piece of code that is be used when you I<always> +want to make the same transformation to all keys and/or values in a DBM +database. All of the database classes (BerkeleyDB::Hash, +BerkeleyDB::Btree and BerkeleyDB::Recno) support DBM Filters. + +There are four methods associated with DBM Filters. All work +identically, and each is used to install (or uninstall) a single DBM +Filter. Each expects a single parameter, namely a reference to a sub. +The only difference between them is the place that the filter is +installed. + +To summarise: + +=over 5 + +=item B<filter_store_key> + +If a filter has been installed with this method, it will be invoked +every time you write a key to a DBM database. + +=item B<filter_store_value> + +If a filter has been installed with this method, it will be invoked +every time you write a value to a DBM database. + + +=item B<filter_fetch_key> + +If a filter has been installed with this method, it will be invoked +every time you read a key from a DBM database. + +=item B<filter_fetch_value> + +If a filter has been installed with this method, it will be invoked +every time you read a value from a DBM database. + +=back + +You can use any combination of the methods, from none, to all four. + +All filter methods return the existing filter, if present, or C<undef> +in not. + +To delete a filter pass C<undef> to it. + +=head2 The Filter + +When each filter is called by Perl, a local copy of C<$_> will contain +the key or value to be filtered. Filtering is achieved by modifying +the contents of C<$_>. The return code from the filter is ignored. + +=head2 An Example -- the NULL termination problem. + +Consider the following scenario. You have a DBM database that you need +to share with a third-party C application. The C application assumes +that I<all> keys and values are NULL terminated. Unfortunately when +Perl writes to DBM databases it doesn't use NULL termination, so your +Perl application will have to manage NULL termination itself. When you +write to the database you will have to use something like this: + + $hash{"$key\0"} = "$value\0" ; + +Similarly the NULL needs to be taken into account when you are considering +the length of existing keys/values. + +It would be much better if you could ignore the NULL terminations issue +in the main application code and have a mechanism that automatically +added the terminating NULL to all keys and values whenever you write to +the database and have them removed when you read from the database. As I'm +sure you have already guessed, this is a problem that DBM Filters can +fix very easily. + + use strict ; + use BerkeleyDB ; + + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + my $db = tie %hash, 'BerkeleyDB::Hash', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Install DBM Filters + $db->filter_fetch_key ( sub { s/\0$// } ) ; + $db->filter_store_key ( sub { $_ .= "\0" } ) ; + $db->filter_fetch_value( sub { s/\0$// } ) ; + $db->filter_store_value( sub { $_ .= "\0" } ) ; + + $hash{"abc"} = "def" ; + my $a = $hash{"ABC"} ; + # ... + undef $db ; + untie %hash ; + +Hopefully the contents of each of the filters should be +self-explanatory. Both "fetch" filters remove the terminating NULL, +and both "store" filters add a terminating NULL. + + +=head2 Another Example -- Key is a C int. + +Here is another real-life example. By default, whenever Perl writes to +a DBM database it always writes the key and value as strings. So when +you use this: + + $hash{12345} = "something" ; + +the key 12345 will get stored in the DBM database as the 5 byte string +"12345". If you actually want the key to be stored in the DBM database +as a C int, you will have to use C<pack> when writing, and C<unpack> +when reading. + +Here is a DBM Filter that does it: + + use strict ; + use BerkeleyDB ; + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + + my $db = tie %hash, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + $db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ; + $db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ; + $hash{123} = "def" ; + # ... + undef $db ; + untie %hash ; + +This time only two filters have been used -- we only need to manipulate +the contents of the key, so it wasn't necessary to install any value +filters. + +=head1 Using BerkeleyDB with MLDBM + +Both BerkeleyDB::Hash and BerkeleyDB::Btree can be used with the MLDBM +module. The code fragment below shows how to open associate MLDBM with +BerkeleyDB::Btree. To use BerkeleyDB::Hash just replace +BerkeleyDB::Btree with BerkeleyDB::Hash. + + use strict ; + use BerkeleyDB ; + use MLDBM qw(BerkeleyDB::Btree) ; + use Data::Dumper; + + my $filename = 'testmldbm' ; + my %o ; + + unlink $filename ; + tie %o, 'MLDBM', -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open database '$filename: $!\n"; + +See the MLDBM documentation for information on how to use the module +and for details of its limitations. + +=head1 EXAMPLES + +TODO. + +=head1 HINTS & TIPS + +=head2 Sharing Databases With C Applications + +There is no technical reason why a Berkeley DB database cannot be +shared by both a Perl and a C application. + +The vast majority of problems that are reported in this area boil down +to the fact that C strings are NULL terminated, whilst Perl strings +are not. See L<An Example -- the NULL termination problem.> in the DBM +FILTERS section for a generic way to work around this problem. + + +=head2 The untie Gotcha + +TODO + +=head1 COMMON QUESTIONS + +This section attempts to answer some of the more common questions that +I get asked. + + +=head2 Relationship with DB_File + +Before Berkeley DB 2.x was written there was only one Perl module that +interfaced to Berkeley DB. That module is called B<DB_File>. Although +B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only provides +an interface to the functionality available in Berkeley DB 1.x. That +means that it doesn't support transactions, locking or any of the other +new features available in DB 2.x or better. + +=head2 How do I store Perl data structures with BerkeleyDB? + +See L<Using BerkeleyDB with MLDBM>. + +=head1 HISTORY + +See the Changes file. + +=head1 AVAILABILITY + +The most recent version of B<BerkeleyDB> can always be found +on CPAN (see L<perlmod/CPAN> for details), in the directory +F<modules/by-module/BerkeleyDB>. + +The official web site for Berkeley DB is F<http://www.sleepycat.com>. + +=head1 COPYRIGHT + +Copyright (c) 1997-2002 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. + +Although B<BerkeleyDB> is covered by the Perl license, the library it +makes use of, namely Berkeley DB, is not. Berkeley DB has its own +copyright and its own license. Please take the time to read it. + +Here are few words taken from the Berkeley DB FAQ (at +F<http://www.sleepycat.com>) regarding the license: + + Do I have to license DB to use it in Perl scripts? + + No. The Berkeley DB license requires that software that uses + Berkeley DB be freely redistributable. In the case of Perl, that + software is Perl, and not your scripts. Any Perl scripts that you + write are your property, including scripts that make use of Berkeley + DB. Neither the Perl license nor the Berkeley DB license + place any restriction on what you may do with them. + +If you are in any doubt about the license situation, contact either the +Berkeley DB authors or the author of BerkeleyDB. +See L<"AUTHOR"> for details. + + +=head1 AUTHOR + +Paul Marquess E<lt>Paul.Marquess@btinternet.comE<gt>. + +Questions about Berkeley DB may be addressed to E<lt>db@sleepycat.comE<gt>. + +=head1 SEE ALSO + +perl(1), DB_File, Berkeley DB. + +=cut diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P new file mode 100644 index 00000000000..4a848f5388d --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P @@ -0,0 +1,1559 @@ +=head1 NAME + +BerkeleyDB - Perl extension for Berkeley DB version 2, 3 or 4 + +=head1 SYNOPSIS + + use BerkeleyDB; + + $env = new BerkeleyDB::Env [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Hash', [OPTIONS] ; + $db = new BerkeleyDB::Hash [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Btree', [OPTIONS] ; + $db = new BerkeleyDB::Btree [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Recno', [OPTIONS] ; + $db = new BerkeleyDB::Recno [OPTIONS] ; + + $db = tie %hash, 'BerkeleyDB::Queue', [OPTIONS] ; + $db = new BerkeleyDB::Queue [OPTIONS] ; + + $db = new BerkeleyDB::Unknown [OPTIONS] ; + + $status = BerkeleyDB::db_remove [OPTIONS] + $status = BerkeleyDB::db_rename [OPTIONS] + $status = BerkeleyDB::db_verify [OPTIONS] + + $hash{$key} = $value ; + $value = $hash{$key} ; + each %hash ; + keys %hash ; + values %hash ; + + $status = $db->db_get() + $status = $db->db_put() ; + $status = $db->db_del() ; + $status = $db->db_sync() ; + $status = $db->db_close() ; + $status = $db->db_close() ; + $status = $db->db_pget() + $hash_ref = $db->db_stat() ; + $status = $db->db_key_range(); + $type = $db->type() ; + $status = $db->status() ; + $boolean = $db->byteswapped() ; + $status = $db->truncate($count) ; + + ($flag, $old_offset, $old_length) = $db->partial_set($offset, $length) ; + ($flag, $old_offset, $old_length) = $db->partial_clear() ; + + $cursor = $db->db_cursor([$flags]) ; + $newcursor = $cursor->c_dup([$flags]); + $status = $cursor->c_get() ; + $status = $cursor->c_put() ; + $status = $cursor->c_del() ; + $status = $cursor->c_count() ; + $status = $cursor->c_pget() ; + $status = $cursor->status() ; + $status = $cursor->c_close() ; + + $cursor = $db->db_join() ; + $status = $cursor->c_get() ; + $status = $cursor->c_close() ; + + $status = $env->txn_checkpoint() + $hash_ref = $env->txn_stat() + $status = $env->setmutexlocks() + $status = $env->set_flags() + + $txn = $env->txn_begin() ; + $db->Txn($txn); + $txn->Txn($db1, $db2,...); + $status = $txn->txn_prepare() + $status = $txn->txn_commit() + $status = $txn->txn_abort() + $status = $txn->txn_id() + $status = $txn->txn_discard() + + $status = $env->set_lg_dir(); + $status = $env->set_lg_bsize(); + $status = $env->set_lg_max(); + + $status = $env->set_data_dir() ; + $status = $env->set_tmp_dir() ; + $status = $env->set_verbose() ; + + $BerkeleyDB::Error + $BerkeleyDB::db_version + + # DBM Filters + $old_filter = $db->filter_store_key ( sub { ... } ) ; + $old_filter = $db->filter_store_value( sub { ... } ) ; + $old_filter = $db->filter_fetch_key ( sub { ... } ) ; + $old_filter = $db->filter_fetch_value( sub { ... } ) ; + + # deprecated, but supported + $txn_mgr = $env->TxnMgr(); + $status = $txn_mgr->txn_checkpoint() + $hash_ref = $txn_mgr->txn_stat() + $txn = $txn_mgr->txn_begin() ; + +=head1 DESCRIPTION + +B<NOTE: This document is still under construction. Expect it to be +incomplete in places.> + +This Perl module provides an interface to most of the functionality +available in Berkeley DB versions 2, 3 and 4. In general it is safe to assume +that the interface provided here to be identical to the Berkeley DB +interface. The main changes have been to make the Berkeley DB API work +in a Perl way. Note that if you are using Berkeley DB 2.x, the new +features available in Berkeley DB 3.x or DB 4.x are not available via +this module. + +The reader is expected to be familiar with the Berkeley DB +documentation. Where the interface provided here is identical to the +Berkeley DB library and the... TODO + +The B<db_appinit>, B<db_cursor>, B<db_open> and B<db_txn> man pages are +particularly relevant. + +The interface to Berkeley DB is implemented with a number of Perl +classes. + +=head1 ENV CLASS + +The B<BerkeleyDB::Env> class provides an interface to the Berkeley DB +function B<db_appinit> in Berkeley DB 2.x or B<db_env_create> and +B<DBENV-E<gt>open> in Berkeley DB 3.x/4.x. Its purpose is to initialise a +number of sub-systems that can then be used in a consistent way in all +the databases you make use of the environment. + +If you don't intend using transactions, locking or logging, then you +shouldn't need to make use of B<BerkeleyDB::Env>. + +=head2 Synopsis + + $env = new BerkeleyDB::Env + [ -Home => $path, ] + [ -Server => $name, ] + [ -CacheSize => $number, ] + [ -Config => { name => value, name => value }, ] + [ -ErrFile => filename, ] + [ -ErrPrefix => "string", ] + [ -Flags => number, ] + [ -SetFlags => bitmask, ] + [ -LockDetect => number, ] + [ -Verbose => boolean, ] + +=over 5 + +All the parameters to the BerkeleyDB::Env constructor are optional. + +=item -Home + +If present, this parameter should point to an existing directory. Any +files that I<aren't> specified with an absolute path in the sub-systems +that are initialised by the BerkeleyDB::Env class will be assumed to +live in the B<Home> directory. + +For example, in the code fragment below the database "fred.db" will be +opened in the directory "/home/databases" because it was specified as a +relative path, but "joe.db" will be opened in "/other" because it was +part of an absolute path. + + $env = new BerkeleyDB::Env + -Home => "/home/databases" + ... + + $db1 = new BerkeleyDB::Hash + -Filename = "fred.db", + -Env => $env + ... + + $db2 = new BerkeleyDB::Hash + -Filename = "/other/joe.db", + -Env => $env + ... + +=item -Server + +If present, this parameter should be the hostname of a server that is running +the Berkeley DB RPC server. All databases will be accessed via the RPC server. + +=item -Cachesize + +If present, this parameter sets the size of the environments shared memory +buffer pool. + +=item -Config + +This is a variation on the C<-Home> parameter, but it allows finer +control of where specific types of files will be stored. + +The parameter expects a reference to a hash. Valid keys are: +B<DB_DATA_DIR>, B<DB_LOG_DIR> and B<DB_TMP_DIR> + +The code below shows an example of how it can be used. + + $env = new BerkeleyDB::Env + -Config => { DB_DATA_DIR => "/home/databases", + DB_LOG_DIR => "/home/logs", + DB_TMP_DIR => "/home/tmp" + } + ... + +=item -ErrFile + +Expects a filenme. Any errors generated internally by Berkeley DB will +be logged to this file. + +=item -ErrPrefix + +Allows a prefix to be added to the error messages before they are sent +to B<-ErrFile>. + +=item -Flags + +The B<Flags> parameter specifies both which sub-systems to initialise, +as well as a number of environment-wide options. +See the Berkeley DB documentation for more details of these options. + +Any of the following can be specified by OR'ing them: + +B<DB_CREATE> + +If any of the files specified do not already exist, create them. + +B<DB_INIT_CDB> + +Initialise the Concurrent Access Methods + +B<DB_INIT_LOCK> + +Initialise the Locking sub-system. + +B<DB_INIT_LOG> + +Initialise the Logging sub-system. + +B<DB_INIT_MPOOL> + +Initialise the ... + +B<DB_INIT_TXN> + +Initialise the ... + +B<DB_MPOOL_PRIVATE> + +Initialise the ... + +B<DB_INIT_MPOOL> is also specified. + +Initialise the ... + +B<DB_NOMMAP> + +Initialise the ... + +B<DB_RECOVER> + + + +B<DB_RECOVER_FATAL> + +B<DB_THREAD> + +B<DB_TXN_NOSYNC> + +B<DB_USE_ENVIRON> + +B<DB_USE_ENVIRON_ROOT> + +=item -SetFlags + +Calls ENV->set_flags with the supplied bitmask. Use this when you need to make +use of DB_ENV->set_flags before DB_ENV->open is called. + +Only valid when Berkeley DB 3.x or better is used. + +=item -LockDetect + +Specifies what to do when a lock conflict occurs. The value should be one of + +B<DB_LOCK_DEFAULT> + +B<DB_LOCK_OLDEST> + +B<DB_LOCK_RANDOM> + +B<DB_LOCK_YOUNGEST> + +=item -Verbose + +Add extra debugging information to the messages sent to B<-ErrFile>. + +=back + +=head2 Methods + +The environment class has the following methods: + +=over 5 + +=item $env->errPrefix("string") ; + +This method is identical to the B<-ErrPrefix> flag. It allows the +error prefix string to be changed dynamically. + +=item $env->set_flags(bitmask, 1|0); + +=item $txn = $env->TxnMgr() + +Constructor for creating a B<TxnMgr> object. +See L<"TRANSACTIONS"> for more details of using transactions. + +This method is deprecated. Access the transaction methods using the B<txn_> +methods below from the environment object directly. + +=item $env->txn_begin() + +TODO + +=item $env->txn_stat() + +TODO + +=item $env->txn_checkpoint() + +TODO + +=item $env->status() + +Returns the status of the last BerkeleyDB::Env method. + +=item $env->setmutexlocks() + +Only available in Berkeley Db 3.0 or greater. Calls +B<db_env_set_mutexlocks> when used with Berkeley DB 3.1.x. When used with +Berkeley DB 3.0 or 3.2 and better it calls B<DBENV-E<gt>set_mutexlocks>. + +=back + +=head2 Examples + +TODO. + +=head1 Global Classes + + $status = BerkeleyDB::db_remove [OPTIONS] + $status = BerkeleyDB::db_rename [OPTIONS] + $status = BerkeleyDB::db_verify [OPTIONS] + +=head1 THE DATABASE CLASSES + +B<BerkeleyDB> supports the following database formats: + +=over 5 + +=item B<BerkeleyDB::Hash> + +This database type allows arbitrary key/value pairs to be stored in data +files. This is equivalent to the functionality provided by other +hashing packages like DBM, NDBM, ODBM, GDBM, and SDBM. Remember though, +the files created using B<BerkeleyDB::Hash> are not compatible with any +of the other packages mentioned. + +A default hashing algorithm, which will be adequate for most applications, +is built into BerkeleyDB. If you do need to use your own hashing algorithm +it is possible to write your own in Perl and have B<BerkeleyDB> use +it instead. + +=item B<BerkeleyDB::Btree> + +The Btree format allows arbitrary key/value pairs to be stored in a +B+tree. + +As with the B<BerkeleyDB::Hash> format, it is possible to provide a +user defined Perl routine to perform the comparison of keys. By default, +though, the keys are stored in lexical order. + +=item B<BerkeleyDB::Recno> + +TODO. + + +=item B<BerkeleyDB::Queue> + +TODO. + +=item B<BerkeleyDB::Unknown> + +This isn't a database format at all. It is used when you want to open an +existing Berkeley DB database without having to know what type is it. + +=back + + +Each of the database formats described above is accessed via a +corresponding B<BerkeleyDB> class. These will be described in turn in +the next sections. + +=head1 BerkeleyDB::Hash + +Equivalent to calling B<db_open> with type B<DB_HASH> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_HASH> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Hash + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Hash specific + [ -Ffactor => number,] + [ -Nelem => number,] + [ -Hash => code reference,] + [ -DupCompare => code reference,] + +and this + + [$db =] tie %hash, 'BerkeleyDB::Hash', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Hash specific + [ -Ffactor => number,] + [ -Nelem => number,] + [ -Hash => code reference,] + [ -DupCompare => code reference,] + + +When the "tie" interface is used, reading from and writing to the database +is achieved via the tied hash. In this case the database operates like +a Perl associative array that happens to be stored on disk. + +In addition to the high-level tied hash interface, it is possible to +make use of the underlying methods provided by Berkeley DB + +=head2 Options + +In addition to the standard set of options (see L<COMMON OPTIONS>) +B<BerkeleyDB::Hash> supports these options: + +=over 5 + +=item -Property + +Used to specify extra flags when opening a database. The following +flags may be specified by logically OR'ing together one or more of the +following values: + +B<DB_DUP> + +When creating a new database, this flag enables the storing of duplicate +keys in the database. If B<DB_DUPSORT> is not specified as well, the +duplicates are stored in the order they are created in the database. + +B<DB_DUPSORT> + +Enables the sorting of duplicate keys in the database. Ignored if +B<DB_DUP> isn't also specified. + +=item -Ffactor + +=item -Nelem + +See the Berkeley DB documentation for details of these options. + +=item -Hash + +Allows you to provide a user defined hash function. If not specified, +a default hash function is used. Here is a template for a user-defined +hash function + + sub hash + { + my ($data) = shift ; + ... + # return the hash value for $data + return $hash ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Hash => \&hash, + ... + +See L<""> for an example. + +=item -DupCompare + +Used in conjunction with the B<DB_DUPOSRT> flag. + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Property => DB_DUP|DB_DUPSORT, + -DupCompare => \&compare, + ... + +=back + + +=head2 Methods + +B<BerkeleyDB::Hash> only supports the standard database methods. +See L<COMMON DATABASE METHODS>. + +=head2 A Simple Tied Hash Example + +## simpleHash + +here is the output: + + Banana Exists + + orange -> orange + tomato -> red + banana -> yellow + +Note that the like ordinary associative arrays, the order of the keys +retrieved from a Hash database are in an apparently random order. + +=head2 Another Simple Hash Example + +Do the same as the previous example but not using tie. + +## simpleHash2 + +=head2 Duplicate keys + +The code below is a variation on the examples above. This time the hash has +been inverted. The key this time is colour and the value is the fruit name. +The B<DB_DUP> flag has been specified to allow duplicates. + +##dupHash + +here is the output: + + orange -> orange + yellow -> banana + red -> apple + red -> tomato + green -> banana + green -> apple + +=head2 Sorting Duplicate Keys + +In the previous example, when there were duplicate keys, the values are +sorted in the order they are stored in. The code below is +identical to the previous example except the B<DB_DUPSORT> flag is +specified. + +##dupSortHash + +Notice that in the output below the duplicate values are sorted. + + orange -> orange + yellow -> banana + red -> apple + red -> tomato + green -> apple + green -> banana + +=head2 Custom Sorting Duplicate Keys + +Another variation + +TODO + +=head2 Changing the hash + +TODO + +=head2 Using db_stat + +TODO + +=head1 BerkeleyDB::Btree + +Equivalent to calling B<db_open> with type B<DB_BTREE> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_BTREE> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + + $db = new BerkeleyDB::Btree + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Btree specific + [ -Minkey => number,] + [ -Compare => code reference,] + [ -DupCompare => code reference,] + [ -Prefix => code reference,] + +and this + + [$db =] tie %hash, 'BerkeleyDB::Btree', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Btree specific + [ -Minkey => number,] + [ -Compare => code reference,] + [ -DupCompare => code reference,] + [ -Prefix => code reference,] + +=head2 Options + +In addition to the standard set of options (see L<COMMON OPTIONS>) +B<BerkeleyDB::Btree> supports these options: + +=over 5 + +=item -Property + +Used to specify extra flags when opening a database. The following +flags may be specified by logically OR'ing together one or more of the +following values: + +B<DB_DUP> + +When creating a new database, this flag enables the storing of duplicate +keys in the database. If B<DB_DUPSORT> is not specified as well, the +duplicates are stored in the order they are created in the database. + +B<DB_DUPSORT> + +Enables the sorting of duplicate keys in the database. Ignored if +B<DB_DUP> isn't also specified. + +=item Minkey + +TODO + +=item Compare + +Allow you to override the default sort order used in the database. See +L<"Changing the sort order"> for an example. + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Compare => \&compare, + ... + +=item Prefix + + sub prefix + { + my ($key, $key2) = @_ ; + ... + # return number of bytes of $key2 which are + # necessary to determine that it is greater than $key1 + return $bytes ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Prefix => \&prefix, + ... +=item DupCompare + + sub compare + { + my ($key, $key2) = @_ ; + ... + # return 0 if $key1 eq $key2 + # -1 if $key1 lt $key2 + # 1 if $key1 gt $key2 + return (-1 , 0 or 1) ; + } + + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -DupCompare => \&compare, + ... + +=back + +=head2 Methods + +B<BerkeleyDB::Btree> supports the following database methods. +See also L<COMMON DATABASE METHODS>. + +All the methods below return 0 to indicate success. + +=over 5 + +=item $status = $db->db_key_range($key, $less, $equal, $greater [, $flags]) + +Given a key, C<$key>, this method returns the proportion of keys less than +C<$key> in C<$less>, the proportion equal to C<$key> in C<$equal> and the +proportion greater than C<$key> in C<$greater>. + +The proportion is returned as a double in the range 0.0 to 1.0. + +=back + +=head2 A Simple Btree Example + +The code below is a simple example of using a btree database. + +## btreeSimple + +Here is the output from the code above. The keys have been sorted using +Berkeley DB's default sorting algorithm. + + Smith + Wall + mouse + + +=head2 Changing the sort order + +It is possible to supply your own sorting algorithm if the one that Berkeley +DB used isn't suitable. The code below is identical to the previous example +except for the case insensitive compare function. + +## btreeSortOrder + +Here is the output from the code above. + + mouse + Smith + Wall + +There are a few point to bear in mind if you want to change the +ordering in a BTREE database: + +=over 5 + +=item 1. + +The new compare function must be specified when you create the database. + +=item 2. + +You cannot change the ordering once the database has been created. Thus +you must use the same compare function every time you access the +database. + +=back + +=head2 Using db_stat + +TODO + +=head1 BerkeleyDB::Recno + +Equivalent to calling B<db_open> with type B<DB_RECNO> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_RECNO> in +Berkeley DB 3.x or greater. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Recno + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Recno specific + [ -Delim => byte,] + [ -Len => number,] + [ -Pad => byte,] + [ -Source => filename,] + +and this + + [$db =] tie @arry, 'BerkeleyDB::Recno', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Recno specific + [ -Delim => byte,] + [ -Len => number,] + [ -Pad => byte,] + [ -Source => filename,] + +=head2 A Recno Example + +Here is a simple example that uses RECNO (if you are using a version +of Perl earlier than 5.004_57 this example won't work -- see +L<Extra RECNO Methods> for a workaround). + +## simpleRecno + +Here is the output from the script: + + The array contains 5 entries + popped black + shifted white + Element 1 Exists with value blue + The last element is green + The 2nd last element is yellow + +=head1 BerkeleyDB::Queue + +Equivalent to calling B<db_create> followed by B<DB-E<gt>open> with +type B<DB_QUEUE> in Berkeley DB 3.x or greater. This database format +isn't available if you use Berkeley DB 2.x. + +Two forms of constructor are supported: + + $db = new BerkeleyDB::Queue + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Queue specific + [ -Len => number,] + [ -Pad => byte,] + [ -ExtentSize => number, ] + +and this + + [$db =] tie @arry, 'BerkeleyDB::Queue', + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + # BerkeleyDB::Queue specific + [ -Len => number,] + [ -Pad => byte,] + + +=head1 BerkeleyDB::Unknown + +This class is used to open an existing database. + +Equivalent to calling B<db_open> with type B<DB_UNKNOWN> in Berkeley DB 2.x and +calling B<db_create> followed by B<DB-E<gt>open> with type B<DB_UNKNOWN> in +Berkeley DB 3.x or greater. + +The constructor looks like this: + + $db = new BerkeleyDB::Unknown + [ -Filename => "filename", ] + [ -Subname => "sub-database name", ] + [ -Flags => flags,] + [ -Property => flags,] + [ -Mode => number,] + [ -Cachesize => number,] + [ -Lorder => number,] + [ -Pagesize => number,] + [ -Env => $env,] + [ -Txn => $txn,] + + +=head2 An example + +=head1 COMMON OPTIONS + +All database access class constructors support the common set of +options defined below. All are optional. + +=over 5 + +=item -Filename + +The database filename. If no filename is specified, a temporary file will +be created and removed once the program terminates. + +=item -Subname + +Specifies the name of the sub-database to open. +This option is only valid if you are using Berkeley DB 3.x or greater. + +=item -Flags + +Specify how the database will be opened/created. The valid flags are: + +B<DB_CREATE> + +Create any underlying files, as necessary. If the files do not already +exist and the B<DB_CREATE> flag is not specified, the call will fail. + +B<DB_NOMMAP> + +Not supported by BerkeleyDB. + +B<DB_RDONLY> + +Opens the database in read-only mode. + +B<DB_THREAD> + +Not supported by BerkeleyDB. + +B<DB_TRUNCATE> + +If the database file already exists, remove all the data before +opening it. + +=item -Mode + +Determines the file protection when the database is created. Defaults +to 0666. + +=item -Cachesize + +=item -Lorder + +=item -Pagesize + +=item -Env + +When working under a Berkeley DB environment, this parameter + +Defaults to no environment. + +=item -Txn + +TODO. + +=back + +=head1 COMMON DATABASE METHODS + +All the database interfaces support the common set of methods defined +below. + +All the methods below return 0 to indicate success. + +=head2 $status = $db->db_get($key, $value [, $flags]) + +Given a key (C<$key>) this method reads the value associated with it +from the database. If it exists, the value read from the database is +returned in the C<$value> parameter. + +The B<$flags> parameter is optional. If present, it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_GET_BOTH> + +When the B<DB_GET_BOTH> flag is specified, B<db_get> checks for the +existence of B<both> the C<$key> B<and> C<$value> in the database. + +=item B<DB_SET_RECNO> + +TODO. + +=back + +In addition, the following value may be set by logically OR'ing it into +the B<$flags> parameter: + +=over 5 + +=item B<DB_RMW> + +TODO + +=back + + +=head2 $status = $db->db_put($key, $value [, $flags]) + +Stores a key/value pair in the database. + +The B<$flags> parameter is optional. If present it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_APPEND> + +This flag is only applicable when accessing a B<BerkeleyDB::Recno> +database. + +TODO. + + +=item B<DB_NOOVERWRITE> + +If this flag is specified and C<$key> already exists in the database, +the call to B<db_put> will return B<DB_KEYEXIST>. + +=back + +=head2 $status = $db->db_del($key [, $flags]) + +Deletes a key/value pair in the database associated with C<$key>. +If duplicate keys are enabled in the database, B<db_del> will delete +B<all> key/value pairs with key C<$key>. + +The B<$flags> parameter is optional and is currently unused. + +=head2 $status = $db->db_sync() + +If any parts of the database are in memory, write them to the database. + +=head2 $cursor = $db->db_cursor([$flags]) + +Creates a cursor object. This is used to access the contents of the +database sequentially. See L<CURSORS> for details of the methods +available when working with cursors. + +The B<$flags> parameter is optional. If present it must be set to B<one> +of the following values: + +=over 5 + +=item B<DB_RMW> + +TODO. + +=back + +=head2 ($flag, $old_offset, $old_length) = $db->partial_set($offset, $length) ; + +TODO + +=head2 ($flag, $old_offset, $old_length) = $db->partial_clear() ; + +TODO + +=head2 $db->byteswapped() + +TODO + +=head2 $db->type() + +Returns the type of the database. The possible return code are B<DB_HASH> +for a B<BerkeleyDB::Hash> database, B<DB_BTREE> for a B<BerkeleyDB::Btree> +database and B<DB_RECNO> for a B<BerkeleyDB::Recno> database. This method +is typically used when a database has been opened with +B<BerkeleyDB::Unknown>. + +=item $ref = $db->db_stat() + +Returns a reference to an associative array containing information about +the database. The keys of the associative array correspond directly to the +names of the fields defined in the Berkeley DB documentation. For example, +in the DB documentation, the field B<bt_version> stores the version of the +Btree database. Assuming you called B<db_stat> on a Btree database the +equivalent field would be accessed as follows: + + $version = $ref->{'bt_version'} ; + +If you are using Berkeley DB 3.x or better, this method will work will +all database formats. When DB 2.x is used, it only works with +B<BerkeleyDB::Btree>. + +=head2 $status = $db->status() + +Returns the status of the last C<$db> method called. + +=head2 $status = $db->truncate($count) + +Truncates the datatabase and returns the number or records deleted +in C<$count>. + +=head1 CURSORS + +A cursor is used whenever you want to access the contents of a database +in sequential order. +A cursor object is created with the C<db_cursor> + +A cursor object has the following methods available: + +=head2 $newcursor = $cursor->c_dup($flags) + +Creates a duplicate of C<$cursor>. This method needs Berkeley DB 3.0.x or better. + +The C<$flags> parameter is optional and can take the following value: + +=over 5 + +=item DB_POSITION + +When present this flag will position the new cursor at the same place as the +existing cursor. + +=back + +=head2 $status = $cursor->c_get($key, $value, $flags) + +Reads a key/value pair from the database, returning the data in C<$key> +and C<$value>. The key/value pair actually read is controlled by the +C<$flags> parameter, which can take B<one> of the following values: + +=over 5 + +=item B<DB_FIRST> + +Set the cursor to point to the first key/value pair in the +database. Return the key/value pair in C<$key> and C<$value>. + +=item B<DB_LAST> + +Set the cursor to point to the last key/value pair in the database. Return +the key/value pair in C<$key> and C<$value>. + +=item B<DB_NEXT> + +If the cursor is already pointing to a key/value pair, it will be +incremented to point to the next key/value pair and return its contents. + +If the cursor isn't initialised, B<DB_NEXT> works just like B<DB_FIRST>. + +If the cursor is already positioned at the last key/value pair, B<c_get> +will return B<DB_NOTFOUND>. + +=item B<DB_NEXT_DUP> + +This flag is only valid when duplicate keys have been enabled in +a database. +If the cursor is already pointing to a key/value pair and the key of +the next key/value pair is identical, the cursor will be incremented to +point to it and their contents returned. + +=item B<DB_PREV> + +If the cursor is already pointing to a key/value pair, it will be +decremented to point to the previous key/value pair and return its +contents. + +If the cursor isn't initialised, B<DB_PREV> works just like B<DB_LAST>. + +If the cursor is already positioned at the first key/value pair, B<c_get> +will return B<DB_NOTFOUND>. + +=item B<DB_CURRENT> + +If the cursor has been set to point to a key/value pair, return their +contents. +If the key/value pair referenced by the cursor has been deleted, B<c_get> +will return B<DB_KEYEMPTY>. + +=item B<DB_SET> + +Set the cursor to point to the key/value pair referenced by B<$key> +and return the value in B<$value>. + +=item B<DB_SET_RANGE> + +This flag is a variation on the B<DB_SET> flag. As well as returning +the value, it also returns the key, via B<$key>. +When used with a B<BerkeleyDB::Btree> database the key matched by B<c_get> +will be the shortest key (in length) which is greater than or equal to +the key supplied, via B<$key>. This allows partial key searches. +See ??? for an example of how to use this flag. + +=item B<DB_GET_BOTH> + +Another variation on B<DB_SET>. This one returns both the key and +the value. + +=item B<DB_SET_RECNO> + +TODO. + +=item B<DB_GET_RECNO> + +TODO. + +=back + +In addition, the following value may be set by logically OR'ing it into +the B<$flags> parameter: + +=over 5 + +=item B<DB_RMW> + +TODO. + +=back + +=head2 $status = $cursor->c_put($key, $value, $flags) + +Stores the key/value pair in the database. The position that the data is +stored in the database is controlled by the C<$flags> parameter, which +must take B<one> of the following values: + +=over 5 + +=item B<DB_AFTER> + +When used with a Btree or Hash database, a duplicate of the key referenced +by the current cursor position will be created and the contents of +B<$value> will be associated with it - B<$key> is ignored. +The new key/value pair will be stored immediately after the current +cursor position. +Obviously the database has to have been opened with B<DB_DUP>. + +When used with a Recno ... TODO + + +=item B<DB_BEFORE> + +When used with a Btree or Hash database, a duplicate of the key referenced +by the current cursor position will be created and the contents of +B<$value> will be associated with it - B<$key> is ignored. +The new key/value pair will be stored immediately before the current +cursor position. +Obviously the database has to have been opened with B<DB_DUP>. + +When used with a Recno ... TODO + +=item B<DB_CURRENT> + +If the cursor has been initialised, replace the value of the key/value +pair stored in the database with the contents of B<$value>. + +=item B<DB_KEYFIRST> + +Only valid with a Btree or Hash database. This flag is only really +used when duplicates are enabled in the database and sorted duplicates +haven't been specified. +In this case the key/value pair will be inserted as the first entry in +the duplicates for the particular key. + +=item B<DB_KEYLAST> + +Only valid with a Btree or Hash database. This flag is only really +used when duplicates are enabled in the database and sorted duplicates +haven't been specified. +In this case the key/value pair will be inserted as the last entry in +the duplicates for the particular key. + +=back + +=head2 $status = $cursor->c_del([$flags]) + +This method deletes the key/value pair associated with the current cursor +position. The cursor position will not be changed by this operation, so +any subsequent cursor operation must first initialise the cursor to +point to a valid key/value pair. + +If the key/value pair associated with the cursor have already been +deleted, B<c_del> will return B<DB_KEYEMPTY>. + +The B<$flags> parameter is not used at present. + +=head2 $status = $cursor->c_del($cnt [, $flags]) + +Stores the number of duplicates at the current cursor position in B<$cnt>. + +The B<$flags> parameter is not used at present. This method needs +Berkeley DB 3.1 or better. + +=head2 $status = $cursor->status() + +Returns the status of the last cursor method as a dual type. + +=head2 Cursor Examples + +TODO + +Iterating from first to last, then in reverse. + +examples of each of the flags. + +=head1 JOIN + +Join support for BerkeleyDB is in progress. Watch this space. + +TODO + +=head1 TRANSACTIONS + +TODO. + +=head1 DBM Filters + +A DBM Filter is a piece of code that is be used when you I<always> +want to make the same transformation to all keys and/or values in a DBM +database. All of the database classes (BerkeleyDB::Hash, +BerkeleyDB::Btree and BerkeleyDB::Recno) support DBM Filters. + +There are four methods associated with DBM Filters. All work +identically, and each is used to install (or uninstall) a single DBM +Filter. Each expects a single parameter, namely a reference to a sub. +The only difference between them is the place that the filter is +installed. + +To summarise: + +=over 5 + +=item B<filter_store_key> + +If a filter has been installed with this method, it will be invoked +every time you write a key to a DBM database. + +=item B<filter_store_value> + +If a filter has been installed with this method, it will be invoked +every time you write a value to a DBM database. + + +=item B<filter_fetch_key> + +If a filter has been installed with this method, it will be invoked +every time you read a key from a DBM database. + +=item B<filter_fetch_value> + +If a filter has been installed with this method, it will be invoked +every time you read a value from a DBM database. + +=back + +You can use any combination of the methods, from none, to all four. + +All filter methods return the existing filter, if present, or C<undef> +in not. + +To delete a filter pass C<undef> to it. + +=head2 The Filter + +When each filter is called by Perl, a local copy of C<$_> will contain +the key or value to be filtered. Filtering is achieved by modifying +the contents of C<$_>. The return code from the filter is ignored. + +=head2 An Example -- the NULL termination problem. + +Consider the following scenario. You have a DBM database that you need +to share with a third-party C application. The C application assumes +that I<all> keys and values are NULL terminated. Unfortunately when +Perl writes to DBM databases it doesn't use NULL termination, so your +Perl application will have to manage NULL termination itself. When you +write to the database you will have to use something like this: + + $hash{"$key\0"} = "$value\0" ; + +Similarly the NULL needs to be taken into account when you are considering +the length of existing keys/values. + +It would be much better if you could ignore the NULL terminations issue +in the main application code and have a mechanism that automatically +added the terminating NULL to all keys and values whenever you write to +the database and have them removed when you read from the database. As I'm +sure you have already guessed, this is a problem that DBM Filters can +fix very easily. + +## nullFilter + +Hopefully the contents of each of the filters should be +self-explanatory. Both "fetch" filters remove the terminating NULL, +and both "store" filters add a terminating NULL. + + +=head2 Another Example -- Key is a C int. + +Here is another real-life example. By default, whenever Perl writes to +a DBM database it always writes the key and value as strings. So when +you use this: + + $hash{12345} = "something" ; + +the key 12345 will get stored in the DBM database as the 5 byte string +"12345". If you actually want the key to be stored in the DBM database +as a C int, you will have to use C<pack> when writing, and C<unpack> +when reading. + +Here is a DBM Filter that does it: + +## intFilter + +This time only two filters have been used -- we only need to manipulate +the contents of the key, so it wasn't necessary to install any value +filters. + +=head1 Using BerkeleyDB with MLDBM + +Both BerkeleyDB::Hash and BerkeleyDB::Btree can be used with the MLDBM +module. The code fragment below shows how to open associate MLDBM with +BerkeleyDB::Btree. To use BerkeleyDB::Hash just replace +BerkeleyDB::Btree with BerkeleyDB::Hash. + + use strict ; + use BerkeleyDB ; + use MLDBM qw(BerkeleyDB::Btree) ; + use Data::Dumper; + + my $filename = 'testmldbm' ; + my %o ; + + unlink $filename ; + tie %o, 'MLDBM', -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open database '$filename: $!\n"; + +See the MLDBM documentation for information on how to use the module +and for details of its limitations. + +=head1 EXAMPLES + +TODO. + +=head1 HINTS & TIPS + +=head2 Sharing Databases With C Applications + +There is no technical reason why a Berkeley DB database cannot be +shared by both a Perl and a C application. + +The vast majority of problems that are reported in this area boil down +to the fact that C strings are NULL terminated, whilst Perl strings +are not. See L<An Example -- the NULL termination problem.> in the DBM +FILTERS section for a generic way to work around this problem. + + +=head2 The untie Gotcha + +TODO + +=head1 COMMON QUESTIONS + +This section attempts to answer some of the more common questions that +I get asked. + + +=head2 Relationship with DB_File + +Before Berkeley DB 2.x was written there was only one Perl module that +interfaced to Berkeley DB. That module is called B<DB_File>. Although +B<DB_File> can be build with Berkeley DB 1.x, 2.x, 3.x or 4.x, it only provides +an interface to the functionality available in Berkeley DB 1.x. That +means that it doesn't support transactions, locking or any of the other +new features available in DB 2.x or better. + +=head2 How do I store Perl data structures with BerkeleyDB? + +See L<Using BerkeleyDB with MLDBM>. + +=head1 HISTORY + +See the Changes file. + +=head1 AVAILABILITY + +The most recent version of B<BerkeleyDB> can always be found +on CPAN (see L<perlmod/CPAN> for details), in the directory +F<modules/by-module/BerkeleyDB>. + +The official web site for Berkeley DB is F<http://www.sleepycat.com>. + +=head1 COPYRIGHT + +Copyright (c) 1997-2002 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. + +Although B<BerkeleyDB> is covered by the Perl license, the library it +makes use of, namely Berkeley DB, is not. Berkeley DB has its own +copyright and its own license. Please take the time to read it. + +Here are few words taken from the Berkeley DB FAQ (at +F<http://www.sleepycat.com>) regarding the license: + + Do I have to license DB to use it in Perl scripts? + + No. The Berkeley DB license requires that software that uses + Berkeley DB be freely redistributable. In the case of Perl, that + software is Perl, and not your scripts. Any Perl scripts that you + write are your property, including scripts that make use of Berkeley + DB. Neither the Perl license nor the Berkeley DB license + place any restriction on what you may do with them. + +If you are in any doubt about the license situation, contact either the +Berkeley DB authors or the author of BerkeleyDB. +See L<"AUTHOR"> for details. + + +=head1 AUTHOR + +Paul Marquess E<lt>Paul.Marquess@btinternet.comE<gt>. + +Questions about Berkeley DB may be addressed to E<lt>db@sleepycat.comE<gt>. + +=head1 SEE ALSO + +perl(1), DB_File, Berkeley DB. + +=cut diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB.xs b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.xs new file mode 100644 index 00000000000..531b38a655f --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB.xs @@ -0,0 +1,3643 @@ +/* + + BerkeleyDB.xs -- Perl 5 interface to Berkeley DB version 2 & 3 + + written by Paul Marquess <Paul.Marquess@btinternet.com> + + All comments/suggestions/problems are welcome + + Copyright (c) 1997-2002 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. + + Please refer to the COPYRIGHT section in + + Changes: + 0.01 - First Alpha Release + 0.02 - + +*/ + + + +#ifdef __cplusplus +extern "C" { +#endif + +#define PERL_POLLUTE +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" + + +/* XSUB.h defines a macro called abort */ +/* This clashes with the txn abort method in Berkeley DB 4.x */ +/* This is a problem with ActivePerl (at least) */ + +#ifdef _WIN32 +# ifdef abort +# undef abort +# endif +# ifdef fopen +# undef fopen +# endif +# ifdef fclose +# undef fclose +# endif +#endif + +/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be + * shortly #included by the <db.h>) __attribute__ to the possibly + * already defined __attribute__, for example by GNUC or by Perl. */ + +#undef __attribute__ + +#ifdef USE_PERLIO +# define GetFILEptr(sv) PerlIO_findFILE(IoOFP(sv_2io(sv))) +#else +# define GetFILEptr(sv) IoOFP(sv_2io(sv)) +#endif + +#include <db.h> + +/* Check the version of Berkeley DB */ + +#ifndef DB_VERSION_MAJOR +#ifdef HASHMAGIC +#error db.h is from Berkeley DB 1.x - need at least Berkeley DB 2.6.4 +#else +#error db.h is not for Berkeley DB at all. +#endif +#endif + +#if (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6) ||\ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 6 && DB_VERSION_PATCH < 4) +# error db.h is from Berkeley DB 2.0-2.5 - need at least Berkeley DB 2.6.4 +#endif + + +#if (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0) +# define IS_DB_3_0_x +#endif + +#if DB_VERSION_MAJOR >= 3 +# define AT_LEAST_DB_3 +#endif + +#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 1) +# define AT_LEAST_DB_3_1 +#endif + +#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 2) +# define AT_LEAST_DB_3_2 +#endif + +#if DB_VERSION_MAJOR > 3 || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 2) ||\ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 2 && DB_VERSION_PATCH >= 6) +# define AT_LEAST_DB_3_2_6 +#endif + +#if DB_VERSION_MAJOR > 3 || (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR >= 3) +# define AT_LEAST_DB_3_3 +#endif + +#if DB_VERSION_MAJOR >= 4 +# define AT_LEAST_DB_4 +#endif + +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1) +# define AT_LEAST_DB_4_1 +#endif + +#ifdef __cplusplus +} +#endif + +#define DBM_FILTERING +#define STRICT_CLOSE +/* #define ALLOW_RECNO_OFFSET */ +/* #define TRACE */ + +#if DB_VERSION_MAJOR == 2 && ! defined(DB_LOCK_DEADLOCK) +# define DB_LOCK_DEADLOCK EAGAIN +#endif /* DB_VERSION_MAJOR == 2 */ + +#if DB_VERSION_MAJOR == 2 +# define DB_QUEUE 4 +#endif /* DB_VERSION_MAJOR == 2 */ + +#ifdef AT_LEAST_DB_3_2 +# define DB_callback DB * db, +#else +# define DB_callback +#endif + +#if DB_VERSION_MAJOR > 2 +typedef struct { + int db_lorder; + size_t db_cachesize; + size_t db_pagesize; + + + void *(*db_malloc) __P((size_t)); + int (*dup_compare) + __P((DB_callback const DBT *, const DBT *)); + + u_int32_t bt_maxkey; + u_int32_t bt_minkey; + int (*bt_compare) + __P((DB_callback const DBT *, const DBT *)); + size_t (*bt_prefix) + __P((DB_callback const DBT *, const DBT *)); + + u_int32_t h_ffactor; + u_int32_t h_nelem; + u_int32_t (*h_hash) + __P((DB_callback const void *, u_int32_t)); + + int re_pad; + int re_delim; + u_int32_t re_len; + char *re_source; + +#define DB_DELIMITER 0x0001 +#define DB_FIXEDLEN 0x0008 +#define DB_PAD 0x0010 + u_int32_t flags; + u_int32_t q_extentsize; +} DB_INFO ; + +#endif /* DB_VERSION_MAJOR > 2 */ + +typedef struct { + int Status ; + /* char ErrBuff[1000] ; */ + SV * ErrPrefix ; + FILE * ErrHandle ; + DB_ENV * Env ; + int open_dbs ; + int TxnMgrStatus ; + int active ; + bool txn_enabled ; + } BerkeleyDB_ENV_type ; + + +typedef struct { + DBTYPE type ; + bool recno_or_queue ; + char * filename ; + BerkeleyDB_ENV_type * parent_env ; + DB * dbp ; + SV * compare ; + bool in_compare ; + SV * dup_compare ; + bool in_dup_compare ; + SV * prefix ; + bool in_prefix ; + SV * hash ; + bool in_hash ; +#ifdef AT_LEAST_DB_3_3 + SV * associated ; + bool secondary_db ; +#endif + int Status ; + DB_INFO * info ; + DBC * cursor ; + DB_TXN * txn ; + int open_cursors ; + u_int32_t partial ; + u_int32_t dlen ; + u_int32_t doff ; + int active ; +#ifdef ALLOW_RECNO_OFFSET + int array_base ; +#endif +#ifdef DBM_FILTERING + SV * filter_fetch_key ; + SV * filter_store_key ; + SV * filter_fetch_value ; + SV * filter_store_value ; + int filtering ; +#endif + } BerkeleyDB_type; + + +typedef struct { + DBTYPE type ; + bool recno_or_queue ; + char * filename ; + DB * dbp ; + SV * compare ; + SV * dup_compare ; + SV * prefix ; + SV * hash ; +#ifdef AT_LEAST_DB_3_3 + SV * associated ; + bool secondary_db ; +#endif + int Status ; + DB_INFO * info ; + DBC * cursor ; + DB_TXN * txn ; + BerkeleyDB_type * parent_db ; + u_int32_t partial ; + u_int32_t dlen ; + u_int32_t doff ; + int active ; +#ifdef ALLOW_RECNO_OFFSET + int array_base ; +#endif +#ifdef DBM_FILTERING + SV * filter_fetch_key ; + SV * filter_store_key ; + SV * filter_fetch_value ; + SV * filter_store_value ; + int filtering ; +#endif + } BerkeleyDB_Cursor_type; + +typedef struct { + BerkeleyDB_ENV_type * env ; + } BerkeleyDB_TxnMgr_type ; + +#if 1 +typedef struct { + int Status ; + DB_TXN * txn ; + int active ; + } BerkeleyDB_Txn_type ; +#else +typedef DB_TXN BerkeleyDB_Txn_type ; +#endif + +typedef BerkeleyDB_ENV_type * BerkeleyDB__Env ; +typedef BerkeleyDB_ENV_type * BerkeleyDB__Env__Raw ; +typedef BerkeleyDB_ENV_type * BerkeleyDB__Env__Inner ; +typedef BerkeleyDB_type * BerkeleyDB ; +typedef void * BerkeleyDB__Raw ; +typedef BerkeleyDB_type * BerkeleyDB__Common ; +typedef BerkeleyDB_type * BerkeleyDB__Common__Raw ; +typedef BerkeleyDB_type * BerkeleyDB__Common__Inner ; +typedef BerkeleyDB_type * BerkeleyDB__Hash ; +typedef BerkeleyDB_type * BerkeleyDB__Hash__Raw ; +typedef BerkeleyDB_type * BerkeleyDB__Btree ; +typedef BerkeleyDB_type * BerkeleyDB__Btree__Raw ; +typedef BerkeleyDB_type * BerkeleyDB__Recno ; +typedef BerkeleyDB_type * BerkeleyDB__Recno__Raw ; +typedef BerkeleyDB_type * BerkeleyDB__Queue ; +typedef BerkeleyDB_type * BerkeleyDB__Queue__Raw ; +typedef BerkeleyDB_Cursor_type BerkeleyDB__Cursor_type ; +typedef BerkeleyDB_Cursor_type * BerkeleyDB__Cursor ; +typedef BerkeleyDB_Cursor_type * BerkeleyDB__Cursor__Raw ; +typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr ; +typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Raw ; +typedef BerkeleyDB_TxnMgr_type * BerkeleyDB__TxnMgr__Inner ; +typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn ; +typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn__Raw ; +typedef BerkeleyDB_Txn_type * BerkeleyDB__Txn__Inner ; +#if 0 +typedef DB_LOG * BerkeleyDB__Log ; +typedef DB_LOCKTAB * BerkeleyDB__Lock ; +#endif +typedef DBT DBTKEY ; +typedef DBT DBT_OPT ; +typedef DBT DBT_B ; +typedef DBT DBTKEY_B ; +typedef DBT DBTVALUE ; +typedef void * PV_or_NULL ; +typedef PerlIO * IO_or_NULL ; +typedef int DualType ; + +static void +hash_delete(char * hash, char * key); + +#ifdef TRACE +# define Trace(x) printf x +#else +# define Trace(x) +#endif + +#ifdef ALLOW_RECNO_OFFSET +# define RECNO_BASE db->array_base +#else +# define RECNO_BASE 1 +#endif + +#if DB_VERSION_MAJOR == 2 +# define flagSet_DB2(i, f) i |= f +#else +# define flagSet_DB2(i, f) +#endif + +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 +# define flagSet(bitmask) (flags & (bitmask)) +#else +# define flagSet(bitmask) ((flags & DB_OPFLAGS_MASK) == (bitmask)) +#endif + +#if DB_VERSION_MAJOR == 2 +# define BackRef internal +#else +# if DB_VERSION_MAJOR == 3 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0) +# define BackRef cj_internal +# else +# define BackRef api_internal +# endif +#endif + +#define ERR_BUFF "BerkeleyDB::Error" + +#define ZMALLOC(to, typ) ((to = (typ *)safemalloc(sizeof(typ))), \ + Zero(to,1,typ)) + +#define DBT_clear(x) Zero(&x, 1, DBT) ; + +#if 1 +#define getInnerObject(x) (*av_fetch((AV*)SvRV(x), 0, FALSE)) +#else +#define getInnerObject(x) ((SV*)SvRV(sv)) +#endif + +#define my_sv_setpvn(sv, d, s) (s ? sv_setpvn(sv, d, s) : sv_setpv(sv, "") ) + +#define SetValue_iv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \ + i = SvIV(sv) +#define SetValue_io(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \ + i = GetFILEptr(sv) +#define SetValue_sv(i, k) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \ + i = sv +#define SetValue_pv(i, k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \ + i = (t)SvPV(sv,PL_na) +#define SetValue_pvx(i, k, t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) \ + i = (t)SvPVX(sv) +#define SetValue_ov(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\ + IV tmp = SvIV(getInnerObject(sv)) ; \ + i = INT2PTR(t, tmp) ; \ + } + +#define SetValue_ovx(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\ + HV * hv = (HV *)GetInternalObject(sv); \ + SV ** svp = hv_fetch(hv, "db", 2, FALSE);\ + IV tmp = SvIV(*svp); \ + i = INT2PTR(t, tmp) ; \ + } + +#define SetValue_ovX(i,k,t) if ((sv = readHash(hash, k)) && sv != &PL_sv_undef) {\ + IV tmp = SvIV(GetInternalObject(sv));\ + i = INT2PTR(t, tmp) ; \ + } + +#define LastDBerror DB_RUNRECOVERY + +#define setDUALerrno(var, err) \ + sv_setnv(var, (double)err) ; \ + sv_setpv(var, ((err) ? db_strerror(err) : "")) ;\ + SvNOK_on(var); + +#define OutputValue(arg, name) \ + { if (RETVAL == 0) { \ + my_sv_setpvn(arg, name.data, name.size) ; \ + DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \ + } \ + } + +#define OutputValue_B(arg, name) \ + { if (RETVAL == 0) { \ + if (db->type == DB_BTREE && \ + flagSet(DB_GET_RECNO)){ \ + sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \ + } \ + else { \ + my_sv_setpvn(arg, name.data, name.size) ; \ + } \ + DBM_ckFilter(arg, filter_fetch_value, "filter_fetch_value"); \ + } \ + } + +#define OutputKey(arg, name) \ + { if (RETVAL == 0) \ + { \ + if (!db->recno_or_queue) { \ + my_sv_setpvn(arg, name.data, name.size); \ + } \ + else \ + sv_setiv(arg, (I32)*(I32*)name.data - RECNO_BASE); \ + DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \ + } \ + } + +#define OutputKey_B(arg, name) \ + { if (RETVAL == 0) \ + { \ + if (db->recno_or_queue || \ + (db->type == DB_BTREE && \ + flagSet(DB_GET_RECNO))){ \ + sv_setiv(arg, (I32)(*(I32*)name.data) - RECNO_BASE); \ + } \ + else { \ + my_sv_setpvn(arg, name.data, name.size); \ + } \ + DBM_ckFilter(arg, filter_fetch_key, "filter_fetch_key") ; \ + } \ + } + +#define SetPartial(data,db) \ + data.flags = db->partial ; \ + data.dlen = db->dlen ; \ + data.doff = db->doff ; + +#define ckActive(active, type) \ + { \ + if (!active) \ + softCrash("%s is already closed", type) ; \ + } + +#define ckActive_Environment(a) ckActive(a, "Environment") +#define ckActive_TxnMgr(a) ckActive(a, "Transaction Manager") +#define ckActive_Transaction(a) ckActive(a, "Transaction") +#define ckActive_Database(a) ckActive(a, "Database") +#define ckActive_Cursor(a) ckActive(a, "Cursor") + +/* Internal Global Data */ +static db_recno_t Value ; +static db_recno_t zero = 0 ; +static BerkeleyDB CurrentDB ; + +static DBTKEY empty ; +#if 0 +static char ErrBuff[1000] ; +#endif + +#ifdef AT_LEAST_DB_3_3 +# if PERL_REVISION == 5 && PERL_VERSION <= 4 + +/* saferealloc in perl5.004 will croak if it is given a NULL pointer*/ +void * +MyRealloc(void * ptr, size_t size) +{ + if (ptr == NULL ) + return safemalloc(size) ; + else + return saferealloc(ptr, size) ; +} + +# else +# define MyRealloc saferealloc +# endif +#endif + +static char * +my_strdup(const char *s) +{ + if (s == NULL) + return NULL ; + + { + MEM_SIZE l = strlen(s); + char *s1 = (char *)safemalloc(l); + + Copy(s, s1, (MEM_SIZE)l, char); + return s1; + } +} + +#if DB_VERSION_MAJOR == 2 +static char * +db_strerror(int err) +{ + if (err == 0) + return "" ; + + if (err > 0) + return Strerror(err) ; + + switch (err) { + case DB_INCOMPLETE: + return ("DB_INCOMPLETE: Sync was unable to complete"); + case DB_KEYEMPTY: + return ("DB_KEYEMPTY: Non-existent key/data pair"); + case DB_KEYEXIST: + return ("DB_KEYEXIST: Key/data pair already exists"); + case DB_LOCK_DEADLOCK: + return ( + "DB_LOCK_DEADLOCK: Locker killed to resolve a deadlock"); + case DB_LOCK_NOTGRANTED: + return ("DB_LOCK_NOTGRANTED: Lock not granted"); + case DB_LOCK_NOTHELD: + return ("DB_LOCK_NOTHELD: Lock not held by locker"); + case DB_NOTFOUND: + return ("DB_NOTFOUND: No matching key/data pair found"); + case DB_RUNRECOVERY: + return ("DB_RUNRECOVERY: Fatal error, run database recovery"); + default: + return "Unknown Error" ; + + } +} +#endif /* DB_VERSION_MAJOR == 2 */ + +#ifdef TRACE +#if DB_VERSION_MAJOR > 2 +static char * +my_db_strerror(int err) +{ + static char buffer[1000] ; + SV * sv = perl_get_sv(ERR_BUFF, FALSE) ; + sprintf(buffer, "%d: %s", err, db_strerror(err)) ; + if (err && sv) { + strcat(buffer, ", ") ; + strcat(buffer, SvPVX(sv)) ; + } + return buffer; +} +#endif +#endif + +static void +close_everything(void) +{ + dTHR; + Trace(("close_everything\n")) ; + /* Abort All Transactions */ + { + BerkeleyDB__Txn__Raw tid ; + HE * he ; + I32 len ; + HV * hv = perl_get_hv("BerkeleyDB::Term::Txn", TRUE); + int all = 0 ; + int closed = 0 ; + (void)hv_iterinit(hv) ; + Trace(("BerkeleyDB::Term::close_all_txns dirty=%d\n", PL_dirty)) ; + while ( (he = hv_iternext(hv)) ) { + tid = * (BerkeleyDB__Txn__Raw *) hv_iterkey(he, &len) ; + Trace((" Aborting Transaction [%d] in [%d] Active [%d]\n", tid->txn, tid, tid->active)); + if (tid->active) { +#ifdef AT_LEAST_DB_4 + tid->txn->abort(tid->txn) ; +#else + txn_abort(tid->txn); +#endif + ++ closed ; + } + tid->active = FALSE ; + ++ all ; + } + Trace(("End of BerkeleyDB::Term::close_all_txns aborted %d of %d transactios\n",closed, all)) ; + } + + /* Close All Cursors */ + { + BerkeleyDB__Cursor db ; + HE * he ; + I32 len ; + HV * hv = perl_get_hv("BerkeleyDB::Term::Cursor", TRUE); + int all = 0 ; + int closed = 0 ; + (void) hv_iterinit(hv) ; + Trace(("BerkeleyDB::Term::close_all_cursors \n")) ; + while ( (he = hv_iternext(hv)) ) { + db = * (BerkeleyDB__Cursor*) hv_iterkey(he, &len) ; + Trace((" Closing Cursor [%d] in [%d] Active [%d]\n", db->cursor, db, db->active)); + if (db->active) { + ((db->cursor)->c_close)(db->cursor) ; + ++ closed ; + } + db->active = FALSE ; + ++ all ; + } + Trace(("End of BerkeleyDB::Term::close_all_cursors closed %d of %d cursors\n",closed, all)) ; + } + + /* Close All Databases */ + { + BerkeleyDB db ; + HE * he ; + I32 len ; + HV * hv = perl_get_hv("BerkeleyDB::Term::Db", TRUE); + int all = 0 ; + int closed = 0 ; + (void)hv_iterinit(hv) ; + Trace(("BerkeleyDB::Term::close_all_dbs\n" )) ; + while ( (he = hv_iternext(hv)) ) { + db = * (BerkeleyDB*) hv_iterkey(he, &len) ; + Trace((" Closing Database [%d] in [%d] Active [%d]\n", db->dbp, db, db->active)); + if (db->active) { + (db->dbp->close)(db->dbp, 0) ; + ++ closed ; + } + db->active = FALSE ; + ++ all ; + } + Trace(("End of BerkeleyDB::Term::close_all_dbs closed %d of %d dbs\n",closed, all)) ; + } + + /* Close All Environments */ + { + BerkeleyDB__Env env ; + HE * he ; + I32 len ; + HV * hv = perl_get_hv("BerkeleyDB::Term::Env", TRUE); + int all = 0 ; + int closed = 0 ; + (void)hv_iterinit(hv) ; + Trace(("BerkeleyDB::Term::close_all_envs\n")) ; + while ( (he = hv_iternext(hv)) ) { + env = * (BerkeleyDB__Env*) hv_iterkey(he, &len) ; + Trace((" Closing Environment [%d] in [%d] Active [%d]\n", env->Env, env, env->active)); + if (env->active) { +#if DB_VERSION_MAJOR == 2 + db_appexit(env->Env) ; +#else + (env->Env->close)(env->Env, 0) ; +#endif + ++ closed ; + } + env->active = FALSE ; + ++ all ; + } + Trace(("End of BerkeleyDB::Term::close_all_envs closed %d of %d dbs\n",closed, all)) ; + } + + Trace(("end close_everything\n")) ; + +} + +static void +destroyDB(BerkeleyDB db) +{ + dTHR; + if (! PL_dirty && db->active) { + -- db->open_cursors ; + ((db->dbp)->close)(db->dbp, 0) ; + } + if (db->hash) + SvREFCNT_dec(db->hash) ; + if (db->compare) + SvREFCNT_dec(db->compare) ; + if (db->dup_compare) + SvREFCNT_dec(db->dup_compare) ; +#ifdef AT_LEAST_DB_3_3 + if (db->associated && !db->secondary_db) + SvREFCNT_dec(db->associated) ; +#endif + if (db->prefix) + SvREFCNT_dec(db->prefix) ; +#ifdef DBM_FILTERING + if (db->filter_fetch_key) + SvREFCNT_dec(db->filter_fetch_key) ; + if (db->filter_store_key) + SvREFCNT_dec(db->filter_store_key) ; + if (db->filter_fetch_value) + SvREFCNT_dec(db->filter_fetch_value) ; + if (db->filter_store_value) + SvREFCNT_dec(db->filter_store_value) ; +#endif + hash_delete("BerkeleyDB::Term::Db", (char *)db) ; + if (db->filename) + Safefree(db->filename) ; + Safefree(db) ; +} + +static int +softCrash(const char *pat, ...) +{ + char buffer1 [500] ; + char buffer2 [500] ; + va_list args; + va_start(args, pat); + + Trace(("softCrash: %s\n", pat)) ; + +#define ABORT_PREFIX "BerkeleyDB Aborting: " + + /* buffer = (char*) safemalloc(strlen(pat) + strlen(ABORT_PREFIX) + 1) ; */ + strcpy(buffer1, ABORT_PREFIX) ; + strcat(buffer1, pat) ; + + vsprintf(buffer2, buffer1, args) ; + + croak(buffer2); + + /* NOTREACHED */ + va_end(args); + return 1 ; +} + + +static I32 +GetArrayLength(BerkeleyDB db) +{ + DBT key ; + DBT value ; + int RETVAL = 0 ; + DBC * cursor ; + + DBT_clear(key) ; + DBT_clear(value) ; +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 + if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor) == 0 ) +#else + if ( ((db->dbp)->cursor)(db->dbp, db->txn, &cursor, 0) == 0 ) +#endif + { + RETVAL = cursor->c_get(cursor, &key, &value, DB_LAST) ; + if (RETVAL == 0) + RETVAL = *(I32 *)key.data ; + else /* No key means empty file */ + RETVAL = 0 ; + cursor->c_close(cursor) ; + } + + Trace(("GetArrayLength got %d\n", RETVAL)) ; + return ((I32)RETVAL) ; +} + +#if 0 + +#define GetRecnoKey(db, value) _GetRecnoKey(db, value) + +static db_recno_t +_GetRecnoKey(BerkeleyDB db, I32 value) +{ + Trace(("GetRecnoKey start value = %d\n", value)) ; + if (db->recno_or_queue && value < 0) { + /* Get the length of the array */ + I32 length = GetArrayLength(db) ; + + /* check for attempt to write before start of array */ + if (length + value + RECNO_BASE <= 0) + softCrash("Modification of non-creatable array value attempted, subscript %ld", (long)value) ; + + value = length + value + RECNO_BASE ; + } + else + ++ value ; + + Trace(("GetRecnoKey end value = %d\n", value)) ; + + return value ; +} + +#else /* ! 0 */ + +#if 0 +#ifdef ALLOW_RECNO_OFFSET +#define GetRecnoKey(db, value) _GetRecnoKey(db, value) + +static db_recno_t +_GetRecnoKey(BerkeleyDB db, I32 value) +{ + if (value + RECNO_BASE < 1) + softCrash("key value %d < base (%d)", (value), RECNO_BASE?0:1) ; + return value + RECNO_BASE ; +} + +#else +#endif /* ALLOW_RECNO_OFFSET */ +#endif /* 0 */ + +#define GetRecnoKey(db, value) ((value) + RECNO_BASE ) + +#endif /* 0 */ + +#if 0 +static SV * +GetInternalObject(SV * sv) +{ + SV * info = (SV*) NULL ; + SV * s ; + MAGIC * mg ; + + Trace(("in GetInternalObject %d\n", sv)) ; + if (sv == NULL || !SvROK(sv)) + return NULL ; + + s = SvRV(sv) ; + if (SvMAGICAL(s)) + { + if (SvTYPE(s) == SVt_PVHV || SvTYPE(s) == SVt_PVAV) + mg = mg_find(s, 'P') ; + else + mg = mg_find(s, 'q') ; + + /* all this testing is probably overkill, but till I know more + about global destruction it stays. + */ + /* if (mg && mg->mg_obj && SvRV(mg->mg_obj) && SvPVX(SvRV(mg->mg_obj))) */ + if (mg && mg->mg_obj && SvRV(mg->mg_obj) ) + info = SvRV(mg->mg_obj) ; + else + info = s ; + } + + Trace(("end of GetInternalObject %d\n", info)) ; + return info ; +} +#endif + +static int +btree_compare(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + char * data1, * data2 ; + int retval ; + int count ; + BerkeleyDB keepDB = CurrentDB ; + + data1 = (char*) key1->data ; + data2 = (char*) key2->data ; + +#ifndef newSVpvn + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (key1->size == 0) + data1 = "" ; + if (key2->size == 0) + data2 = "" ; +#endif + + ENTER ; + SAVETMPS; + + PUSHMARK(SP) ; + EXTEND(SP,2) ; + PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); + PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUTBACK ; + + count = perl_call_sv(CurrentDB->compare, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + softCrash ("in btree_compare - expected 1 return value from compare sub, got %d", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + CurrentDB = keepDB ; + return (retval) ; + +} + +static int +dup_compare(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + char * data1, * data2 ; + int retval ; + int count ; + BerkeleyDB keepDB = CurrentDB ; + + Trace(("In dup_compare \n")) ; + if (!CurrentDB) + softCrash("Internal Error - No CurrentDB in dup_compare") ; + if (CurrentDB->dup_compare == NULL) + softCrash("in dup_compare: no callback specified for database '%s'", CurrentDB->filename) ; + + data1 = (char*) key1->data ; + data2 = (char*) key2->data ; + +#ifndef newSVpvn + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (key1->size == 0) + data1 = "" ; + if (key2->size == 0) + data2 = "" ; +#endif + + ENTER ; + SAVETMPS; + + PUSHMARK(SP) ; + EXTEND(SP,2) ; + PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); + PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUTBACK ; + + count = perl_call_sv(CurrentDB->dup_compare, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + softCrash ("dup_compare: expected 1 return value from compare sub, got %d", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + CurrentDB = keepDB ; + return (retval) ; + +} + +static size_t +btree_prefix(DB_callback const DBT * key1, const DBT * key2 ) +{ + dSP ; + char * data1, * data2 ; + int retval ; + int count ; + BerkeleyDB keepDB = CurrentDB ; + + data1 = (char*) key1->data ; + data2 = (char*) key2->data ; + +#ifndef newSVpvn + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (key1->size == 0) + data1 = "" ; + if (key2->size == 0) + data2 = "" ; +#endif + + ENTER ; + SAVETMPS; + + PUSHMARK(SP) ; + EXTEND(SP,2) ; + PUSHs(sv_2mortal(newSVpvn(data1,key1->size))); + PUSHs(sv_2mortal(newSVpvn(data2,key2->size))); + PUTBACK ; + + count = perl_call_sv(CurrentDB->prefix, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + softCrash ("btree_prefix: expected 1 return value from prefix sub, got %d", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + CurrentDB = keepDB ; + + return (retval) ; +} + +static u_int32_t +hash_cb(DB_callback const void * data, u_int32_t size) +{ + dSP ; + int retval ; + int count ; + BerkeleyDB keepDB = CurrentDB ; + +#ifndef newSVpvn + if (size == 0) + data = "" ; +#endif + + ENTER ; + SAVETMPS; + + PUSHMARK(SP) ; + + XPUSHs(sv_2mortal(newSVpvn((char*)data,size))); + PUTBACK ; + + count = perl_call_sv(CurrentDB->hash, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + softCrash ("hash_cb: expected 1 return value from hash sub, got %d", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + CurrentDB = keepDB ; + + return (retval) ; +} + +#ifdef AT_LEAST_DB_3_3 + +static int +associate_cb(DB_callback const DBT * pkey, const DBT * pdata, DBT * skey) +{ + dSP ; + char * pk_dat, * pd_dat, *sk_dat ; + int retval ; + int count ; + SV * skey_SV ; + + Trace(("In associate_cb \n")) ; + if (((BerkeleyDB)db->BackRef)->associated == NULL){ + Trace(("No Callback registered\n")) ; + return EINVAL ; + } + + skey_SV = newSVpv("",0); + + + pk_dat = (char*) pkey->data ; + pd_dat = (char*) pdata->data ; + +#ifndef newSVpvn + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (pkey->size == 0) + pk_dat = "" ; + if (pdata->size == 0) + pd_dat = "" ; +#endif + + ENTER ; + SAVETMPS; + + PUSHMARK(SP) ; + EXTEND(SP,2) ; + PUSHs(sv_2mortal(newSVpvn(pk_dat,pkey->size))); + PUSHs(sv_2mortal(newSVpvn(pd_dat,pdata->size))); + PUSHs(sv_2mortal(skey_SV)); + PUTBACK ; + + Trace(("calling associated cb\n")); + count = perl_call_sv(((BerkeleyDB)db->BackRef)->associated, G_SCALAR); + Trace(("called associated cb\n")); + + SPAGAIN ; + + if (count != 1) + softCrash ("associate: expected 1 return value from prefix sub, got %d", count) ; + + retval = POPi ; + + PUTBACK ; + + /* retrieve the secondary key */ + DBT_clear(*skey); + skey->flags = DB_DBT_APPMALLOC; + skey->size = SvCUR(skey_SV); + skey->data = (char*)safemalloc(skey->size); + memcpy(skey->data, SvPVX(skey_SV), skey->size); + Trace(("key is %d -- %.*s\n", skey->size, skey->size, skey->data)); + + FREETMPS ; + LEAVE ; + + return (retval) ; +} + +#endif /* AT_LEAST_DB_3_3 */ + +static void +db_errcall_cb(const char * db_errpfx, char * buffer) +{ +#if 0 + + if (db_errpfx == NULL) + db_errpfx = "" ; + if (buffer == NULL ) + buffer = "" ; + ErrBuff[0] = '\0'; + if (strlen(db_errpfx) + strlen(buffer) + 3 <= 1000) { + if (*db_errpfx != '\0') { + strcat(ErrBuff, db_errpfx) ; + strcat(ErrBuff, ": ") ; + } + strcat(ErrBuff, buffer) ; + } + +#endif + + SV * sv = perl_get_sv(ERR_BUFF, FALSE) ; + if (sv) { + if (db_errpfx) + sv_setpvf(sv, "%s: %s", db_errpfx, buffer) ; + else + sv_setpv(sv, buffer) ; + } +} + +static SV * +readHash(HV * hash, char * key) +{ + SV ** svp; + svp = hv_fetch(hash, key, strlen(key), FALSE); + if (svp && SvOK(*svp)) + return *svp ; + return NULL ; +} + +static void +hash_delete(char * hash, char * key) +{ + HV * hv = perl_get_hv(hash, TRUE); + (void) hv_delete(hv, (char*)&key, sizeof(key), G_DISCARD); +} + +static void +hash_store_iv(char * hash, char * key, IV value) +{ + HV * hv = perl_get_hv(hash, TRUE); + (void)hv_store(hv, (char*)&key, sizeof(key), newSViv(value), 0); + /* printf("hv_store returned %d\n", ret) ; */ +} + +static void +hv_store_iv(HV * hash, char * key, IV value) +{ + hv_store(hash, key, strlen(key), newSViv(value), 0); +} + +static BerkeleyDB +my_db_open( + BerkeleyDB db , + SV * ref, + SV * ref_dbenv , + BerkeleyDB__Env dbenv , + BerkeleyDB__Txn txn, + const char * file, + const char * subname, + DBTYPE type, + int flags, + int mode, + DB_INFO * info + ) +{ + DB_ENV * env = NULL ; + BerkeleyDB RETVAL = NULL ; + DB * dbp ; + int Status ; + DB_TXN* txnid = NULL ; + + Trace(("_db_open(dbenv[%p] ref_dbenv [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n", + dbenv, ref_dbenv, file, subname, type, flags, mode)) ; + + CurrentDB = db ; + if (dbenv) + env = dbenv->Env ; + + if (txn) + txnid = txn->txn; + + Trace(("_db_open(dbenv[%p] ref_dbenv [%p] txn [%p] file[%s] subname [%s] type[%d] flags[%d] mode[%d]\n", + dbenv, ref_dbenv, txn, file, subname, type, flags, mode)) ; + +#if DB_VERSION_MAJOR == 2 + if (subname) + softCrash("Subname needs Berkeley DB 3 or better") ; +#endif + +#if DB_VERSION_MAJOR > 2 + Status = db_create(&dbp, env, 0) ; + Trace(("db_create returned %s\n", my_db_strerror(Status))) ; + if (Status) + return RETVAL ; + +#ifdef AT_LEAST_DB_3_3 + if (! env) { + dbp->set_alloc(dbp, safemalloc, MyRealloc, safefree) ; + dbp->set_errcall(dbp, db_errcall_cb) ; + } +#endif + + if (info->re_source) { + Status = dbp->set_re_source(dbp, info->re_source) ; + Trace(("set_re_source [%s] returned %s\n", + info->re_source, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->db_cachesize) { + Status = dbp->set_cachesize(dbp, 0, info->db_cachesize, 0) ; + Trace(("set_cachesize [%d] returned %s\n", + info->db_cachesize, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->db_lorder) { + Status = dbp->set_lorder(dbp, info->db_lorder) ; + Trace(("set_lorder [%d] returned %s\n", + info->db_lorder, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->db_pagesize) { + Status = dbp->set_pagesize(dbp, info->db_pagesize) ; + Trace(("set_pagesize [%d] returned %s\n", + info->db_pagesize, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->h_ffactor) { + Status = dbp->set_h_ffactor(dbp, info->h_ffactor) ; + Trace(("set_h_ffactor [%d] returned %s\n", + info->h_ffactor, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->h_nelem) { + Status = dbp->set_h_nelem(dbp, info->h_nelem) ; + Trace(("set_h_nelem [%d] returned %s\n", + info->h_nelem, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->bt_minkey) { + Status = dbp->set_bt_minkey(dbp, info->bt_minkey) ; + Trace(("set_bt_minkey [%d] returned %s\n", + info->bt_minkey, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->bt_compare) { + Status = dbp->set_bt_compare(dbp, info->bt_compare) ; + Trace(("set_bt_compare [%p] returned %s\n", + info->bt_compare, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->h_hash) { + Status = dbp->set_h_hash(dbp, info->h_hash) ; + Trace(("set_h_hash [%d] returned %s\n", + info->h_hash, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->dup_compare) { + Status = dbp->set_dup_compare(dbp, info->dup_compare) ; + Trace(("set_dup_compare [%d] returned %s\n", + info->dup_compare, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->bt_prefix) { + Status = dbp->set_bt_prefix(dbp, info->bt_prefix) ; + Trace(("set_bt_prefix [%d] returned %s\n", + info->bt_prefix, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->re_len) { + Status = dbp->set_re_len(dbp, info->re_len) ; + Trace(("set_re_len [%d] returned %s\n", + info->re_len, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->re_delim) { + Status = dbp->set_re_delim(dbp, info->re_delim) ; + Trace(("set_re_delim [%d] returned %s\n", + info->re_delim, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->re_pad) { + Status = dbp->set_re_pad(dbp, info->re_pad) ; + Trace(("set_re_pad [%d] returned %s\n", + info->re_pad, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->flags) { + Status = dbp->set_flags(dbp, info->flags) ; + Trace(("set_flags [%d] returned %s\n", + info->flags, my_db_strerror(Status))); + if (Status) + return RETVAL ; + } + + if (info->q_extentsize) { +#ifdef AT_LEAST_DB_3_2 + Status = dbp->set_q_extentsize(dbp, info->q_extentsize) ; + Trace(("set_flags [%d] returned %s\n", + info->flags, my_db_strerror(Status))); + if (Status) + return RETVAL ; +#else + softCrash("-ExtentSize needs at least Berkeley DB 3.2.x") ; +#endif + } + +#ifdef AT_LEAST_DB_4_1 + if ((Status = (dbp->open)(dbp, txnid, file, subname, type, flags, mode)) == 0) { +#else + if ((Status = (dbp->open)(dbp, file, subname, type, flags, mode)) == 0) { +#endif /* AT_LEAST_DB_4_1 */ +#else /* DB_VERSION_MAJOR == 2 */ + if ((Status = db_open(file, type, flags, mode, env, info, &dbp)) == 0) { +#endif /* DB_VERSION_MAJOR == 2 */ + + Trace(("db_opened ok\n")); +#ifdef AT_LEAST_DB_3_3 + dbp->BackRef = db; +#endif + RETVAL = db ; + RETVAL->dbp = dbp ; + RETVAL->txn = txnid ; +#if DB_VERSION_MAJOR == 2 + RETVAL->type = dbp->type ; +#else /* DB_VERSION_MAJOR > 2 */ +#ifdef AT_LEAST_DB_3_3 + dbp->get_type(dbp, &RETVAL->type) ; +#else /* DB 3.0 -> 3.2 */ + RETVAL->type = dbp->get_type(dbp) ; +#endif +#endif /* DB_VERSION_MAJOR > 2 */ + RETVAL->recno_or_queue = (RETVAL->type == DB_RECNO || + RETVAL->type == DB_QUEUE) ; + RETVAL->filename = my_strdup(file) ; + RETVAL->Status = Status ; + RETVAL->active = TRUE ; + hash_store_iv("BerkeleyDB::Term::Db", (char *)RETVAL, 1) ; + Trace((" storing %p %p in BerkeleyDB::Term::Db\n", RETVAL, dbp)) ; + if (dbenv) { + RETVAL->parent_env = dbenv ; + dbenv->Status = Status ; + ++ dbenv->open_dbs ; + } + } + else { +#if DB_VERSION_MAJOR > 2 + (dbp->close)(dbp, 0) ; +#endif + destroyDB(db) ; + Trace(("db open returned %s\n", my_db_strerror(Status))) ; + } + + return RETVAL ; +} + + +#include "constants.h" + +MODULE = BerkeleyDB PACKAGE = BerkeleyDB PREFIX = env_ + +INCLUDE: constants.xs + +#define env_db_version(maj, min, patch) db_version(&maj, &min, &patch) +char * +env_db_version(maj, min, patch) + int maj + int min + int patch + OUTPUT: + RETVAL + maj + min + patch + +int +db_value_set(value, which) + int value + int which + NOT_IMPLEMENTED_YET + + +DualType +_db_remove(ref) + SV * ref + CODE: + { +#if DB_VERSION_MAJOR == 2 + softCrash("BerkeleyDB::db_remove needs Berkeley DB 3.x or better") ; +#else + HV * hash ; + DB * dbp ; + SV * sv ; + const char * db = NULL ; + const char * subdb = NULL ; + BerkeleyDB__Env env = NULL ; + DB_ENV * dbenv = NULL ; + u_int32_t flags = 0 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(db, "Filename", char *) ; + SetValue_pv(subdb, "Subname", char *) ; + SetValue_iv(flags, "Flags") ; + SetValue_ov(env, "Env", BerkeleyDB__Env) ; + if (env) + dbenv = env->Env ; + RETVAL = db_create(&dbp, dbenv, 0) ; + if (RETVAL == 0) { + RETVAL = dbp->remove(dbp, db, subdb, flags) ; + } +#endif + } + OUTPUT: + RETVAL + +DualType +_db_verify(ref) + SV * ref + CODE: + { +#ifndef AT_LEAST_DB_3_1 + softCrash("BerkeleyDB::db_verify needs Berkeley DB 3.1.x or better") ; +#else + HV * hash ; + DB * dbp ; + SV * sv ; + const char * db = NULL ; + const char * subdb = NULL ; + const char * outfile = NULL ; + FILE * ofh = NULL; + BerkeleyDB__Env env = NULL ; + DB_ENV * dbenv = NULL ; + u_int32_t flags = 0 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(db, "Filename", char *) ; + SetValue_pv(subdb, "Subname", char *) ; + SetValue_pv(outfile, "Outfile", char *) ; + SetValue_iv(flags, "Flags") ; + SetValue_ov(env, "Env", BerkeleyDB__Env) ; + RETVAL = 0; + if (outfile){ + ofh = fopen(outfile, "w"); + if (! ofh) + RETVAL = errno; + } + if (! RETVAL) { + if (env) + dbenv = env->Env ; + RETVAL = db_create(&dbp, dbenv, 0) ; + if (RETVAL == 0) { + RETVAL = dbp->verify(dbp, db, subdb, ofh, flags) ; + } + if (outfile) + fclose(ofh); + } +#endif + } + OUTPUT: + RETVAL + +DualType +_db_rename(ref) + SV * ref + CODE: + { +#ifndef AT_LEAST_DB_3_1 + softCrash("BerkeleyDB::db_rename needs Berkeley DB 3.1.x or better") ; +#else + HV * hash ; + DB * dbp ; + SV * sv ; + const char * db = NULL ; + const char * subdb = NULL ; + const char * newname = NULL ; + BerkeleyDB__Env env = NULL ; + DB_ENV * dbenv = NULL ; + u_int32_t flags = 0 ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(db, "Filename", char *) ; + SetValue_pv(subdb, "Subname", char *) ; + SetValue_pv(newname, "Newname", char *) ; + SetValue_iv(flags, "Flags") ; + SetValue_ov(env, "Env", BerkeleyDB__Env) ; + if (env) + dbenv = env->Env ; + RETVAL = db_create(&dbp, dbenv, 0) ; + if (RETVAL == 0) { + RETVAL = dbp->rename(dbp, db, subdb, newname, flags) ; + } +#endif + } + OUTPUT: + RETVAL + +MODULE = BerkeleyDB::Env PACKAGE = BerkeleyDB::Env PREFIX = env_ + + +BerkeleyDB::Env::Raw +_db_appinit(self, ref) + char * self + SV * ref + CODE: + { + HV * hash ; + SV * sv ; + char * home = NULL ; + char * errfile = NULL ; + char * server = NULL ; + char ** config = NULL ; + int flags = 0 ; + int setflags = 0 ; + int cachesize = 0 ; + int lk_detect = 0 ; + SV * errprefix = NULL; + DB_ENV * env ; + int status ; + + Trace(("in _db_appinit [%s] %d\n", self, ref)) ; + hash = (HV*) SvRV(ref) ; + SetValue_pv(home, "Home", char *) ; + SetValue_pv(config, "Config", char **) ; + SetValue_sv(errprefix, "ErrPrefix") ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(setflags, "SetFlags") ; + SetValue_pv(server, "Server", char *) ; + SetValue_iv(cachesize, "Cachesize") ; + SetValue_iv(lk_detect, "LockDetect") ; +#ifndef AT_LEAST_DB_3_2 + if (setflags) + softCrash("-SetFlags needs Berkeley DB 3.x or better") ; +#endif /* ! AT_LEAST_DB_3 */ +#ifndef AT_LEAST_DB_3_1 + if (server) + softCrash("-Server needs Berkeley DB 3.1 or better") ; +#endif /* ! AT_LEAST_DB_3_1 */ + Trace(("_db_appinit(config=[%d], home=[%s],errprefix=[%s],flags=[%d]\n", + config, home, errprefix, flags)) ; +#ifdef TRACE + if (config) { + int i ; + for (i = 0 ; i < 10 ; ++ i) { + if (config[i] == NULL) { + printf(" End\n") ; + break ; + } + printf(" config = [%s]\n", config[i]) ; + } + } +#endif /* TRACE */ + ZMALLOC(RETVAL, BerkeleyDB_ENV_type) ; + if (flags & DB_INIT_TXN) + RETVAL->txn_enabled = TRUE ; +#if DB_VERSION_MAJOR == 2 + ZMALLOC(RETVAL->Env, DB_ENV) ; + env = RETVAL->Env ; + { + /* Take a copy of the error prefix */ + if (errprefix) { + Trace(("copying errprefix\n" )) ; + RETVAL->ErrPrefix = newSVsv(errprefix) ; + SvPOK_only(RETVAL->ErrPrefix) ; + } + if (RETVAL->ErrPrefix) + RETVAL->Env->db_errpfx = SvPVX(RETVAL->ErrPrefix) ; + + SetValue_pv(errfile, "ErrFile", char *) ; + if (errfile) { + RETVAL->ErrHandle = env->db_errfile = fopen(errfile, "w"); + if (RETVAL->ErrHandle == NULL) + croak("Cannot open file %s: %s\n", errfile, Strerror(errno)); + } + SetValue_iv(env->db_verbose, "Verbose") ; + env->db_errcall = db_errcall_cb ; + RETVAL->active = TRUE ; + status = db_appinit(home, config, env, flags) ; + Trace((" status = %d env %d Env %d\n", status, RETVAL, env)) ; + if (status == 0) + hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ; + else { + if (RETVAL->ErrHandle) + fclose(RETVAL->ErrHandle) ; + if (RETVAL->ErrPrefix) + SvREFCNT_dec(RETVAL->ErrPrefix) ; + Safefree(RETVAL->Env) ; + Safefree(RETVAL) ; + RETVAL = NULL ; + } + } +#else /* DB_VERSION_MAJOR > 2 */ +#ifndef AT_LEAST_DB_3_1 +# define DB_CLIENT 0 +#endif + status = db_env_create(&RETVAL->Env, server ? DB_CLIENT : 0) ; + Trace(("db_env_create flags = %d returned %s\n", flags, + my_db_strerror(status))) ; + env = RETVAL->Env ; +#ifdef AT_LEAST_DB_3_3 + env->set_alloc(env, safemalloc, MyRealloc, safefree) ; +#endif + if (status == 0 && cachesize) { + status = env->set_cachesize(env, 0, cachesize, 0) ; + Trace(("set_cachesize [%d] returned %s\n", + cachesize, my_db_strerror(status))); + } + + if (status == 0 && lk_detect) { + status = env->set_lk_detect(env, lk_detect) ; + Trace(("set_lk_detect [%d] returned %s\n", + lk_detect, my_db_strerror(status))); + } +#ifdef AT_LEAST_DB_4 + /* set the server */ + if (server && status == 0) + { + status = env->set_rpc_server(env, NULL, server, 0, 0, 0); + Trace(("ENV->set_rpc_server server = %s returned %s\n", server, + my_db_strerror(status))) ; + } +#else +# if defined(AT_LEAST_DB_3_1) && ! defined(AT_LEAST_DB_4) + /* set the server */ + if (server && status == 0) + { + status = env->set_server(env, server, 0, 0, 0); + Trace(("ENV->set_server server = %s returned %s\n", server, + my_db_strerror(status))) ; + } +# endif +#endif +#ifdef AT_LEAST_DB_3_2 + if (setflags && status == 0) + { + status = env->set_flags(env, setflags, 1); + Trace(("ENV->set_flags value = %d returned %s\n", setflags, + my_db_strerror(status))) ; + } +#endif + if (status == 0) + { + int mode = 0 ; + /* Take a copy of the error prefix */ + if (errprefix) { + Trace(("copying errprefix\n" )) ; + RETVAL->ErrPrefix = newSVsv(errprefix) ; + SvPOK_only(RETVAL->ErrPrefix) ; + } + if (RETVAL->ErrPrefix) + env->set_errpfx(env, SvPVX(RETVAL->ErrPrefix)) ; + + SetValue_pv(errfile, "ErrFile", char *) ; + if (errfile) { + RETVAL->ErrHandle = fopen(errfile, "w"); + if (RETVAL->ErrHandle == NULL) + croak("Cannot open file %s: %s\n", errfile, Strerror(errno)); + env->set_errfile(env, RETVAL->ErrHandle) ; + } + + SetValue_iv(mode, "Mode") ; + env->set_errcall(env, db_errcall_cb) ; + RETVAL->active = TRUE ; +#ifdef IS_DB_3_0_x + status = (env->open)(env, home, config, flags, mode) ; +#else /* > 3.0 */ + status = (env->open)(env, home, flags, mode) ; +#endif + Trace(("ENV->open returned %s\n", my_db_strerror(status))) ; + } + + if (status == 0) + hash_store_iv("BerkeleyDB::Term::Env", (char *)RETVAL, 1) ; + else { + (env->close)(env, 0) ; + if (RETVAL->ErrHandle) + fclose(RETVAL->ErrHandle) ; + if (RETVAL->ErrPrefix) + SvREFCNT_dec(RETVAL->ErrPrefix) ; + Safefree(RETVAL) ; + RETVAL = NULL ; + } +#endif /* DB_VERSION_MAJOR > 2 */ + } + OUTPUT: + RETVAL + +void +log_archive(env, flags=0) + u_int32_t flags + BerkeleyDB::Env env + PPCODE: + { + char ** list; + char ** file; + AV * av; +#ifndef AT_LEAST_DB_3 + softCrash("log_archive needs at least Berkeley DB 3.x.x"); +#else +# ifdef AT_LEAST_DB_4 + env->Status = env->Env->log_archive(env->Env, &list, flags) ; +# else +# ifdef AT_LEAST_DB_3_3 + env->Status = log_archive(env->Env, &list, flags) ; +# else + env->Status = log_archive(env->Env, &list, flags, safemalloc) ; +# endif +# endif + if (env->Status == 0 && list != NULL) + { + for (file = list; *file != NULL; ++file) + { + XPUSHs(sv_2mortal(newSVpv(*file, 0))) ; + } + safefree(list); + } +#endif + } + +BerkeleyDB::Txn::Raw +_txn_begin(env, pid=NULL, flags=0) + u_int32_t flags + BerkeleyDB::Env env + BerkeleyDB::Txn pid + CODE: + { + DB_TXN *txn ; + DB_TXN *p_id = NULL ; + Trace(("txn_begin pid %d, flags %d\n", pid, flags)) ; +#if DB_VERSION_MAJOR == 2 + if (env->Env->tx_info == NULL) + softCrash("Transaction Manager not enabled") ; +#endif + if (!env->txn_enabled) + softCrash("Transaction Manager not enabled") ; + if (pid) + p_id = pid->txn ; + env->TxnMgrStatus = +#if DB_VERSION_MAJOR == 2 + txn_begin(env->Env->tx_info, p_id, &txn) ; +#else +# ifdef AT_LEAST_DB_4 + env->Env->txn_begin(env->Env, p_id, &txn, flags) ; +# else + txn_begin(env->Env, p_id, &txn, flags) ; +# endif +#endif + if (env->TxnMgrStatus == 0) { + ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ; + RETVAL->txn = txn ; + RETVAL->active = TRUE ; + Trace(("_txn_begin created txn [%p] in [%p]\n", txn, RETVAL)); + hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ; + } + else + RETVAL = NULL ; + } + OUTPUT: + RETVAL + + +#if DB_VERSION_MAJOR == 2 +# define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env->tx_info, k, m) +#else /* DB 3.0 or better */ +# ifdef AT_LEAST_DB_4 +# define env_txn_checkpoint(e,k,m,f) e->Env->txn_checkpoint(e->Env, k, m, f) +# else +# ifdef AT_LEAST_DB_3_1 +# define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m, 0) +# else +# define env_txn_checkpoint(e,k,m,f) txn_checkpoint(e->Env, k, m) +# endif +# endif +#endif +DualType +env_txn_checkpoint(env, kbyte, min, flags=0) + BerkeleyDB::Env env + long kbyte + long min + u_int32_t flags + +HV * +txn_stat(env) + BerkeleyDB::Env env + HV * RETVAL = NULL ; + CODE: + { + DB_TXN_STAT * stat ; +#ifdef AT_LEAST_DB_4 + if(env->Env->txn_stat(env->Env, &stat, 0) == 0) { +#else +# ifdef AT_LEAST_DB_3_3 + if(txn_stat(env->Env, &stat) == 0) { +# else +# if DB_VERSION_MAJOR == 2 + if(txn_stat(env->Env->tx_info, &stat, safemalloc) == 0) { +# else + if(txn_stat(env->Env, &stat, safemalloc) == 0) { +# endif +# endif +#endif + RETVAL = (HV*)sv_2mortal((SV*)newHV()) ; + hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ; + hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ; + hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ; + hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ; + hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ; + hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ; + hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ; +#if DB_VERSION_MAJOR > 2 + hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ; + hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ; + hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ; + hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ; +#endif + safefree(stat) ; + } + } + OUTPUT: + RETVAL + +#define EnDis(x) ((x) ? "Enabled" : "Disabled") +void +printEnv(env) + BerkeleyDB::Env env + INIT: + ckActive_Environment(env->active) ; + CODE: +#if 0 + printf("env [0x%X]\n", env) ; + printf(" ErrPrefix [%s]\n", env->ErrPrefix + ? SvPVX(env->ErrPrefix) : 0) ; + printf(" DB_ENV\n") ; + printf(" db_lorder [%d]\n", env->Env.db_lorder) ; + printf(" db_home [%s]\n", env->Env.db_home) ; + printf(" db_data_dir [%s]\n", env->Env.db_data_dir) ; + printf(" db_log_dir [%s]\n", env->Env.db_log_dir) ; + printf(" db_tmp_dir [%s]\n", env->Env.db_tmp_dir) ; + printf(" lk_info [%s]\n", EnDis(env->Env.lk_info)) ; + printf(" lk_max [%d]\n", env->Env.lk_max) ; + printf(" lg_info [%s]\n", EnDis(env->Env.lg_info)) ; + printf(" lg_max [%d]\n", env->Env.lg_max) ; + printf(" mp_info [%s]\n", EnDis(env->Env.mp_info)) ; + printf(" mp_size [%d]\n", env->Env.mp_size) ; + printf(" tx_info [%s]\n", EnDis(env->Env.tx_info)) ; + printf(" tx_max [%d]\n", env->Env.tx_max) ; + printf(" flags [%d]\n", env->Env.flags) ; + printf("\n") ; +#endif + +SV * +errPrefix(env, prefix) + BerkeleyDB::Env env + SV * prefix + INIT: + ckActive_Environment(env->active) ; + CODE: + if (env->ErrPrefix) { + RETVAL = newSVsv(env->ErrPrefix) ; + SvPOK_only(RETVAL) ; + sv_setsv(env->ErrPrefix, prefix) ; + } + else { + RETVAL = NULL ; + env->ErrPrefix = newSVsv(prefix) ; + } + SvPOK_only(env->ErrPrefix) ; +#if DB_VERSION_MAJOR == 2 + env->Env->db_errpfx = SvPVX(env->ErrPrefix) ; +#else + env->Env->set_errpfx(env->Env, SvPVX(env->ErrPrefix)) ; +#endif + OUTPUT: + RETVAL + +DualType +status(env) + BerkeleyDB::Env env + CODE: + RETVAL = env->Status ; + OUTPUT: + RETVAL + +DualType +db_appexit(env) + BerkeleyDB::Env env + ALIAS: close =1 + INIT: + ckActive_Environment(env->active) ; + CODE: +#ifdef STRICT_CLOSE + if (env->open_dbs) + softCrash("attempted to close an environment with %d open database(s)", + env->open_dbs) ; +#endif /* STRICT_CLOSE */ +#if DB_VERSION_MAJOR == 2 + RETVAL = db_appexit(env->Env) ; +#else + RETVAL = (env->Env->close)(env->Env, 0) ; +#endif + env->active = FALSE ; + hash_delete("BerkeleyDB::Term::Env", (char *)env) ; + OUTPUT: + RETVAL + + +void +_DESTROY(env) + BerkeleyDB::Env env + int RETVAL = 0 ; + CODE: + Trace(("In BerkeleyDB::Env::DESTROY\n")); + Trace((" env %ld Env %ld dirty %d\n", env, &env->Env, PL_dirty)) ; + if (env->active) +#if DB_VERSION_MAJOR == 2 + db_appexit(env->Env) ; +#else + (env->Env->close)(env->Env, 0) ; +#endif + if (env->ErrHandle) + fclose(env->ErrHandle) ; + if (env->ErrPrefix) + SvREFCNT_dec(env->ErrPrefix) ; +#if DB_VERSION_MAJOR == 2 + Safefree(env->Env) ; +#endif + Safefree(env) ; + hash_delete("BerkeleyDB::Term::Env", (char *)env) ; + Trace(("End of BerkeleyDB::Env::DESTROY %d\n", RETVAL)) ; + +BerkeleyDB::TxnMgr::Raw +_TxnMgr(env) + BerkeleyDB::Env env + INIT: + ckActive_Environment(env->active) ; + if (!env->txn_enabled) + softCrash("Transaction Manager not enabled") ; + CODE: + ZMALLOC(RETVAL, BerkeleyDB_TxnMgr_type) ; + RETVAL->env = env ; + /* hash_store_iv("BerkeleyDB::Term::TxnMgr", (char *)txn, 1) ; */ + OUTPUT: + RETVAL + +int +set_lg_dir(env, dir) + BerkeleyDB::Env env + char * dir + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3_1 + softCrash("$env->set_lg_dir needs Berkeley DB 3.1 or better") ; +#else + RETVAL = env->Status = env->Env->set_lg_dir(env->Env, dir); +#endif + OUTPUT: + RETVAL + +int +set_lg_bsize(env, bsize) + BerkeleyDB::Env env + u_int32_t bsize + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3 + softCrash("$env->set_lg_bsize needs Berkeley DB 3.0.55 or better") ; +#else + RETVAL = env->Status = env->Env->set_lg_bsize(env->Env, bsize); +#endif + OUTPUT: + RETVAL + +int +set_lg_max(env, lg_max) + BerkeleyDB::Env env + u_int32_t lg_max + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3 + softCrash("$env->set_lg_max needs Berkeley DB 3.0.55 or better") ; +#else + RETVAL = env->Status = env->Env->set_lg_max(env->Env, lg_max); +#endif + OUTPUT: + RETVAL + +int +set_data_dir(env, dir) + BerkeleyDB::Env env + char * dir + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3_1 + softCrash("$env->set_data_dir needs Berkeley DB 3.1 or better") ; +#else + RETVAL = env->Status = env->Env->set_data_dir(env->Env, dir); +#endif + OUTPUT: + RETVAL + +int +set_tmp_dir(env, dir) + BerkeleyDB::Env env + char * dir + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3_1 + softCrash("$env->set_tmp_dir needs Berkeley DB 3.1 or better") ; +#else + RETVAL = env->Status = env->Env->set_tmp_dir(env->Env, dir); +#endif + OUTPUT: + RETVAL + +int +set_mutexlocks(env, do_lock) + BerkeleyDB::Env env + int do_lock + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3 + softCrash("$env->set_setmutexlocks needs Berkeley DB 3.0 or better") ; +#else +# ifdef AT_LEAST_DB_4 + RETVAL = env->Status = env->Env->set_flags(env->Env, DB_NOLOCKING, do_lock); +# else +# if defined(AT_LEAST_DB_3_2_6) || defined(IS_DB_3_0_x) + RETVAL = env->Status = env->Env->set_mutexlocks(env->Env, do_lock); +# else /* DB 3.1 or 3.2.3 */ + RETVAL = env->Status = db_env_set_mutexlocks(do_lock); +# endif +# endif +#endif + OUTPUT: + RETVAL + +int +set_verbose(env, which, onoff) + BerkeleyDB::Env env + u_int32_t which + int onoff + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3 + softCrash("$env->set_verbose needs Berkeley DB 3.x or better") ; +#else + RETVAL = env->Status = env->Env->set_verbose(env->Env, which, onoff); +#endif + OUTPUT: + RETVAL + +int +set_flags(env, flags, onoff) + BerkeleyDB::Env env + u_int32_t flags + int onoff + INIT: + ckActive_Database(env->active) ; + CODE: +#ifndef AT_LEAST_DB_3_2 + softCrash("$env->set_flags needs Berkeley DB 3.2.x or better") ; +#else + RETVAL = env->Status = env->Env->set_flags(env->Env, flags, onoff); +#endif + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Term PACKAGE = BerkeleyDB::Term + +void +close_everything() + +#define safeCroak(string) softCrash(string) +void +safeCroak(string) + char * string + +MODULE = BerkeleyDB::Hash PACKAGE = BerkeleyDB::Hash PREFIX = hash_ + +BerkeleyDB::Hash::Raw +_db_open_hash(self, ref) + char * self + SV * ref + CODE: + { + HV * hash ; + SV * sv ; + DB_INFO info ; + BerkeleyDB__Env dbenv = NULL; + SV * ref_dbenv = NULL; + const char * file = NULL ; + const char * subname = NULL ; + int flags = 0 ; + int mode = 0 ; + BerkeleyDB db ; + BerkeleyDB__Txn txn = NULL ; + + Trace(("_db_open_hash start\n")) ; + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char *) ; + SetValue_pv(subname, "Subname", char *) ; + SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ; + SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ; + ref_dbenv = sv ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(mode, "Mode") ; + + Zero(&info, 1, DB_INFO) ; + SetValue_iv(info.db_cachesize, "Cachesize") ; + SetValue_iv(info.db_lorder, "Lorder") ; + SetValue_iv(info.db_pagesize, "Pagesize") ; + SetValue_iv(info.h_ffactor, "Ffactor") ; + SetValue_iv(info.h_nelem, "Nelem") ; + SetValue_iv(info.flags, "Property") ; + ZMALLOC(db, BerkeleyDB_type) ; + if ((sv = readHash(hash, "Hash")) && sv != &PL_sv_undef) { + info.h_hash = hash_cb ; + db->hash = newSVsv(sv) ; + } + /* DB_DUPSORT was introduced in DB 2.5.9 */ + if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) { +#ifdef DB_DUPSORT + info.dup_compare = dup_compare ; + db->dup_compare = newSVsv(sv) ; + info.flags |= DB_DUP|DB_DUPSORT ; +#else + croak("DupCompare needs Berkeley DB 2.5.9 or later") ; +#endif + } + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_HASH, flags, mode, &info) ; + Trace(("_db_open_hash end\n")) ; + } + OUTPUT: + RETVAL + + +HV * +db_stat(db, flags=0) + int flags + BerkeleyDB::Common db + HV * RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { +#if DB_VERSION_MAJOR == 2 + softCrash("$db->db_stat for a Hash needs Berkeley DB 3.x or better") ; +#else + DB_HASH_STAT * stat ; +#ifdef AT_LEAST_DB_3_3 + db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ; +#else + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; +#endif + if (db->Status == 0) { + RETVAL = (HV*)sv_2mortal((SV*)newHV()) ; + hv_store_iv(RETVAL, "hash_magic", stat->hash_magic) ; + hv_store_iv(RETVAL, "hash_version", stat->hash_version); + hv_store_iv(RETVAL, "hash_pagesize", stat->hash_pagesize); +#ifdef AT_LEAST_DB_3_1 + hv_store_iv(RETVAL, "hash_nkeys", stat->hash_nkeys); + hv_store_iv(RETVAL, "hash_ndata", stat->hash_ndata); +#else + hv_store_iv(RETVAL, "hash_nrecs", stat->hash_nrecs); +#endif +#ifndef AT_LEAST_DB_3_1 + hv_store_iv(RETVAL, "hash_nelem", stat->hash_nelem); +#endif + hv_store_iv(RETVAL, "hash_ffactor", stat->hash_ffactor); + hv_store_iv(RETVAL, "hash_buckets", stat->hash_buckets); + hv_store_iv(RETVAL, "hash_free", stat->hash_free); + hv_store_iv(RETVAL, "hash_bfree", stat->hash_bfree); + hv_store_iv(RETVAL, "hash_bigpages", stat->hash_bigpages); + hv_store_iv(RETVAL, "hash_big_bfree", stat->hash_big_bfree); + hv_store_iv(RETVAL, "hash_overflows", stat->hash_overflows); + hv_store_iv(RETVAL, "hash_ovfl_free", stat->hash_ovfl_free); + hv_store_iv(RETVAL, "hash_dup", stat->hash_dup); + hv_store_iv(RETVAL, "hash_dup_free", stat->hash_dup_free); +#if DB_VERSION_MAJOR >= 3 + hv_store_iv(RETVAL, "hash_metaflags", stat->hash_metaflags); +#endif + safefree(stat) ; + } +#endif + } + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Unknown PACKAGE = BerkeleyDB::Unknown PREFIX = hash_ + +void +_db_open_unknown(ref) + SV * ref + PPCODE: + { + HV * hash ; + SV * sv ; + DB_INFO info ; + BerkeleyDB__Env dbenv = NULL; + SV * ref_dbenv = NULL; + const char * file = NULL ; + const char * subname = NULL ; + int flags = 0 ; + int mode = 0 ; + BerkeleyDB db ; + BerkeleyDB RETVAL ; + BerkeleyDB__Txn txn = NULL ; + static char * Names[] = {"", "Btree", "Hash", "Recno"} ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char *) ; + SetValue_pv(subname, "Subname", char *) ; + SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ; + SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ; + ref_dbenv = sv ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(mode, "Mode") ; + + Zero(&info, 1, DB_INFO) ; + SetValue_iv(info.db_cachesize, "Cachesize") ; + SetValue_iv(info.db_lorder, "Lorder") ; + SetValue_iv(info.db_pagesize, "Pagesize") ; + SetValue_iv(info.h_ffactor, "Ffactor") ; + SetValue_iv(info.h_nelem, "Nelem") ; + SetValue_iv(info.flags, "Property") ; + ZMALLOC(db, BerkeleyDB_type) ; + + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_UNKNOWN, flags, mode, &info) ; + XPUSHs(sv_2mortal(newSViv(PTR2IV(RETVAL)))); + if (RETVAL) + XPUSHs(sv_2mortal(newSVpv(Names[RETVAL->type], 0))) ; + else + XPUSHs(sv_2mortal(newSViv((IV)NULL))); + } + + + +MODULE = BerkeleyDB::Btree PACKAGE = BerkeleyDB::Btree PREFIX = btree_ + +BerkeleyDB::Btree::Raw +_db_open_btree(self, ref) + char * self + SV * ref + CODE: + { + HV * hash ; + SV * sv ; + DB_INFO info ; + BerkeleyDB__Env dbenv = NULL; + SV * ref_dbenv = NULL; + const char * file = NULL ; + const char * subname = NULL ; + int flags = 0 ; + int mode = 0 ; + BerkeleyDB db ; + BerkeleyDB__Txn txn = NULL ; + + Trace(("In _db_open_btree\n")); + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Filename", char*) ; + SetValue_pv(subname, "Subname", char *) ; + SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ; + SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ; + ref_dbenv = sv ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(mode, "Mode") ; + + Zero(&info, 1, DB_INFO) ; + SetValue_iv(info.db_cachesize, "Cachesize") ; + SetValue_iv(info.db_lorder, "Lorder") ; + SetValue_iv(info.db_pagesize, "Pagesize") ; + SetValue_iv(info.bt_minkey, "Minkey") ; + SetValue_iv(info.flags, "Property") ; + ZMALLOC(db, BerkeleyDB_type) ; + if ((sv = readHash(hash, "Compare")) && sv != &PL_sv_undef) { + Trace((" Parsed Compare callback\n")); + info.bt_compare = btree_compare ; + db->compare = newSVsv(sv) ; + } + /* DB_DUPSORT was introduced in DB 2.5.9 */ + if ((sv = readHash(hash, "DupCompare")) && sv != &PL_sv_undef) { +#ifdef DB_DUPSORT + Trace((" Parsed DupCompare callback\n")); + info.dup_compare = dup_compare ; + db->dup_compare = newSVsv(sv) ; + info.flags |= DB_DUP|DB_DUPSORT ; +#else + softCrash("DupCompare needs Berkeley DB 2.5.9 or later") ; +#endif + } + if ((sv = readHash(hash, "Prefix")) && sv != &PL_sv_undef) { + Trace((" Parsed Prefix callback\n")); + info.bt_prefix = btree_prefix ; + db->prefix = newSVsv(sv) ; + } + + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_BTREE, flags, mode, &info) ; + } + OUTPUT: + RETVAL + + +HV * +db_stat(db, flags=0) + int flags + BerkeleyDB::Common db + HV * RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { + DB_BTREE_STAT * stat ; +#ifdef AT_LEAST_DB_3_3 + db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ; +#else + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; +#endif + if (db->Status == 0) { + RETVAL = (HV*)sv_2mortal((SV*)newHV()) ; + hv_store_iv(RETVAL, "bt_magic", stat->bt_magic); + hv_store_iv(RETVAL, "bt_version", stat->bt_version); +#if DB_VERSION_MAJOR > 2 + hv_store_iv(RETVAL, "bt_metaflags", stat->bt_metaflags) ; + hv_store_iv(RETVAL, "bt_flags", stat->bt_metaflags) ; +#else + hv_store_iv(RETVAL, "bt_flags", stat->bt_flags) ; +#endif + hv_store_iv(RETVAL, "bt_maxkey", stat->bt_maxkey) ; + hv_store_iv(RETVAL, "bt_minkey", stat->bt_minkey); + hv_store_iv(RETVAL, "bt_re_len", stat->bt_re_len); + hv_store_iv(RETVAL, "bt_re_pad", stat->bt_re_pad); + hv_store_iv(RETVAL, "bt_pagesize", stat->bt_pagesize); + hv_store_iv(RETVAL, "bt_levels", stat->bt_levels); +#ifdef AT_LEAST_DB_3_1 + hv_store_iv(RETVAL, "bt_nkeys", stat->bt_nkeys); + hv_store_iv(RETVAL, "bt_ndata", stat->bt_ndata); +#else + hv_store_iv(RETVAL, "bt_nrecs", stat->bt_nrecs); +#endif + hv_store_iv(RETVAL, "bt_int_pg", stat->bt_int_pg); + hv_store_iv(RETVAL, "bt_leaf_pg", stat->bt_leaf_pg); + hv_store_iv(RETVAL, "bt_dup_pg", stat->bt_dup_pg); + hv_store_iv(RETVAL, "bt_over_pg", stat->bt_over_pg); + hv_store_iv(RETVAL, "bt_free", stat->bt_free); +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 + hv_store_iv(RETVAL, "bt_freed", stat->bt_freed); + hv_store_iv(RETVAL, "bt_pfxsaved", stat->bt_pfxsaved); + hv_store_iv(RETVAL, "bt_split", stat->bt_split); + hv_store_iv(RETVAL, "bt_rootsplit", stat->bt_rootsplit); + hv_store_iv(RETVAL, "bt_fastsplit", stat->bt_fastsplit); + hv_store_iv(RETVAL, "bt_added", stat->bt_added); + hv_store_iv(RETVAL, "bt_deleted", stat->bt_deleted); + hv_store_iv(RETVAL, "bt_get", stat->bt_get); + hv_store_iv(RETVAL, "bt_cache_hit", stat->bt_cache_hit); + hv_store_iv(RETVAL, "bt_cache_miss", stat->bt_cache_miss); +#endif + hv_store_iv(RETVAL, "bt_int_pgfree", stat->bt_int_pgfree); + hv_store_iv(RETVAL, "bt_leaf_pgfree", stat->bt_leaf_pgfree); + hv_store_iv(RETVAL, "bt_dup_pgfree", stat->bt_dup_pgfree); + hv_store_iv(RETVAL, "bt_over_pgfree", stat->bt_over_pgfree); + safefree(stat) ; + } + } + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Recno PACKAGE = BerkeleyDB::Recno PREFIX = recno_ + +BerkeleyDB::Recno::Raw +_db_open_recno(self, ref) + char * self + SV * ref + CODE: + { + HV * hash ; + SV * sv ; + DB_INFO info ; + BerkeleyDB__Env dbenv = NULL; + SV * ref_dbenv = NULL; + const char * file = NULL ; + const char * subname = NULL ; + int flags = 0 ; + int mode = 0 ; + BerkeleyDB db ; + BerkeleyDB__Txn txn = NULL ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Fname", char*) ; + SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ; + ref_dbenv = sv ; + SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(mode, "Mode") ; + + Zero(&info, 1, DB_INFO) ; + SetValue_iv(info.db_cachesize, "Cachesize") ; + SetValue_iv(info.db_lorder, "Lorder") ; + SetValue_iv(info.db_pagesize, "Pagesize") ; + SetValue_iv(info.bt_minkey, "Minkey") ; + + SetValue_iv(info.flags, "Property") ; + SetValue_pv(info.re_source, "Source", char*) ; + if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) { + info.re_len = SvIV(sv) ; ; + flagSet_DB2(info.flags, DB_FIXEDLEN) ; + } + if ((sv = readHash(hash, "Delim")) && sv != &PL_sv_undef) { + info.re_delim = SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ; + flagSet_DB2(info.flags, DB_DELIMITER) ; + } + if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) { + info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ; + flagSet_DB2(info.flags, DB_PAD) ; + } + ZMALLOC(db, BerkeleyDB_type) ; +#ifdef ALLOW_RECNO_OFFSET + SetValue_iv(db->array_base, "ArrayBase") ; + db->array_base = (db->array_base == 0 ? 1 : 0) ; +#endif /* ALLOW_RECNO_OFFSET */ + + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_RECNO, flags, mode, &info) ; + } + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Queue PACKAGE = BerkeleyDB::Queue PREFIX = recno_ + +BerkeleyDB::Queue::Raw +_db_open_queue(self, ref) + char * self + SV * ref + CODE: + { +#ifndef AT_LEAST_DB_3 + softCrash("BerkeleyDB::Queue needs Berkeley DB 3.0.x or better"); +#else + HV * hash ; + SV * sv ; + DB_INFO info ; + BerkeleyDB__Env dbenv = NULL; + SV * ref_dbenv = NULL; + const char * file = NULL ; + const char * subname = NULL ; + int flags = 0 ; + int mode = 0 ; + BerkeleyDB db ; + BerkeleyDB__Txn txn = NULL ; + + hash = (HV*) SvRV(ref) ; + SetValue_pv(file, "Fname", char*) ; + SetValue_ov(dbenv, "Env", BerkeleyDB__Env) ; + ref_dbenv = sv ; + SetValue_ov(txn, "Txn", BerkeleyDB__Txn) ; + SetValue_iv(flags, "Flags") ; + SetValue_iv(mode, "Mode") ; + + Zero(&info, 1, DB_INFO) ; + SetValue_iv(info.db_cachesize, "Cachesize") ; + SetValue_iv(info.db_lorder, "Lorder") ; + SetValue_iv(info.db_pagesize, "Pagesize") ; + SetValue_iv(info.bt_minkey, "Minkey") ; + SetValue_iv(info.q_extentsize, "ExtentSize") ; + + + SetValue_iv(info.flags, "Property") ; + if ((sv = readHash(hash, "Len")) && sv != &PL_sv_undef) { + info.re_len = SvIV(sv) ; ; + flagSet_DB2(info.flags, DB_FIXEDLEN) ; + } + if ((sv = readHash(hash, "Pad")) && sv != &PL_sv_undef) { + info.re_pad = (u_int32_t)SvPOK(sv) ? *SvPV(sv,PL_na) : SvIV(sv) ; ; + flagSet_DB2(info.flags, DB_PAD) ; + } + ZMALLOC(db, BerkeleyDB_type) ; +#ifdef ALLOW_RECNO_OFFSET + SetValue_iv(db->array_base, "ArrayBase") ; + db->array_base = (db->array_base == 0 ? 1 : 0) ; +#endif /* ALLOW_RECNO_OFFSET */ + + RETVAL = my_db_open(db, ref, ref_dbenv, dbenv, txn, file, subname, DB_QUEUE, flags, mode, &info) ; +#endif + } + OUTPUT: + RETVAL + +HV * +db_stat(db, flags=0) + int flags + BerkeleyDB::Common db + HV * RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { +#if DB_VERSION_MAJOR == 2 + softCrash("$db->db_stat for a Queue needs Berkeley DB 3.x or better") ; +#else /* Berkeley DB 3, or better */ + DB_QUEUE_STAT * stat ; +#ifdef AT_LEAST_DB_3_3 + db->Status = ((db->dbp)->stat)(db->dbp, &stat, flags) ; +#else + db->Status = ((db->dbp)->stat)(db->dbp, &stat, safemalloc, flags) ; +#endif + if (db->Status == 0) { + RETVAL = (HV*)sv_2mortal((SV*)newHV()) ; + hv_store_iv(RETVAL, "qs_magic", stat->qs_magic) ; + hv_store_iv(RETVAL, "qs_version", stat->qs_version); +#ifdef AT_LEAST_DB_3_1 + hv_store_iv(RETVAL, "qs_nkeys", stat->qs_nkeys); + hv_store_iv(RETVAL, "qs_ndata", stat->qs_ndata); +#else + hv_store_iv(RETVAL, "qs_nrecs", stat->qs_nrecs); +#endif + hv_store_iv(RETVAL, "qs_pages", stat->qs_pages); + hv_store_iv(RETVAL, "qs_pagesize", stat->qs_pagesize); + hv_store_iv(RETVAL, "qs_pgfree", stat->qs_pgfree); + hv_store_iv(RETVAL, "qs_re_len", stat->qs_re_len); + hv_store_iv(RETVAL, "qs_re_pad", stat->qs_re_pad); +#ifdef AT_LEAST_DB_3_2 +#else + hv_store_iv(RETVAL, "qs_start", stat->qs_start); +#endif + hv_store_iv(RETVAL, "qs_first_recno", stat->qs_first_recno); + hv_store_iv(RETVAL, "qs_cur_recno", stat->qs_cur_recno); +#if DB_VERSION_MAJOR >= 3 + hv_store_iv(RETVAL, "qs_metaflags", stat->qs_metaflags); +#endif + safefree(stat) ; + } +#endif + } + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Common PACKAGE = BerkeleyDB::Common PREFIX = dab_ + + +DualType +db_close(db,flags=0) + int flags + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CurrentDB = db ; + CODE: + Trace(("BerkeleyDB::Common::db_close %d\n", db)); +#ifdef STRICT_CLOSE + if (db->txn) + softCrash("attempted to close a database while a transaction was still open") ; + if (db->open_cursors) + softCrash("attempted to close a database with %d open cursor(s)", + db->open_cursors) ; +#endif /* STRICT_CLOSE */ + RETVAL = db->Status = ((db->dbp)->close)(db->dbp, flags) ; + if (db->parent_env && db->parent_env->open_dbs) + -- db->parent_env->open_dbs ; + db->active = FALSE ; + hash_delete("BerkeleyDB::Term::Db", (char *)db) ; + -- db->open_cursors ; + Trace(("end of BerkeleyDB::Common::db_close\n")); + OUTPUT: + RETVAL + +void +dab__DESTROY(db) + BerkeleyDB::Common db + CODE: + CurrentDB = db ; + Trace(("In BerkeleyDB::Common::_DESTROY db %d dirty=%d\n", db, PL_dirty)) ; + destroyDB(db) ; + Trace(("End of BerkeleyDB::Common::DESTROY \n")) ; + +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6 +#define db_cursor(db, txn, cur,flags) ((db->dbp)->cursor)(db->dbp, txn, cur) +#else +#define db_cursor(db, txn, cur,flags) ((db->dbp)->cursor)(db->dbp, txn, cur,flags) +#endif +BerkeleyDB::Cursor::Raw +_db_cursor(db, flags=0) + u_int32_t flags + BerkeleyDB::Common db + BerkeleyDB::Cursor RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { + DBC * cursor ; + CurrentDB = db ; + if ((db->Status = db_cursor(db, db->txn, &cursor, flags)) == 0){ + ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ; + db->open_cursors ++ ; + RETVAL->parent_db = db ; + RETVAL->cursor = cursor ; + RETVAL->dbp = db->dbp ; + RETVAL->txn = db->txn ; + RETVAL->type = db->type ; + RETVAL->recno_or_queue = db->recno_or_queue ; + RETVAL->filename = my_strdup(db->filename) ; + RETVAL->compare = db->compare ; + RETVAL->dup_compare = db->dup_compare ; +#ifdef AT_LEAST_DB_3_3 + RETVAL->associated = db->associated ; + RETVAL->secondary_db = db->secondary_db; +#endif + RETVAL->prefix = db->prefix ; + RETVAL->hash = db->hash ; + RETVAL->partial = db->partial ; + RETVAL->doff = db->doff ; + RETVAL->dlen = db->dlen ; + RETVAL->active = TRUE ; +#ifdef ALLOW_RECNO_OFFSET + RETVAL->array_base = db->array_base ; +#endif /* ALLOW_RECNO_OFFSET */ +#ifdef DBM_FILTERING + RETVAL->filtering = FALSE ; + RETVAL->filter_fetch_key = db->filter_fetch_key ; + RETVAL->filter_store_key = db->filter_store_key ; + RETVAL->filter_fetch_value = db->filter_fetch_value ; + RETVAL->filter_store_value = db->filter_store_value ; +#endif + /* RETVAL->info ; */ + hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ; + } + } + OUTPUT: + RETVAL + +BerkeleyDB::Cursor::Raw +_db_join(db, cursors, flags=0) + u_int32_t flags + BerkeleyDB::Common db + AV * cursors + BerkeleyDB::Cursor RETVAL = NULL ; + INIT: + ckActive_Database(db->active) ; + CODE: + { +#if DB_VERSION_MAJOR == 2 && (DB_VERSION_MINOR < 5 || (DB_VERSION_MINOR == 5 && DB_VERSION_PATCH < 2)) + softCrash("join needs Berkeley DB 2.5.2 or later") ; +#else /* Berkeley DB >= 2.5.2 */ + DBC * join_cursor ; + DBC ** cursor_list ; + I32 count = av_len(cursors) + 1 ; + int i ; + CurrentDB = db ; + if (count < 1 ) + softCrash("db_join: No cursors in parameter list") ; + cursor_list = (DBC **)safemalloc(sizeof(DBC*) * (count + 1)); + for (i = 0 ; i < count ; ++i) { + SV * obj = (SV*) * av_fetch(cursors, i, FALSE) ; + IV tmp = SvIV(getInnerObject(obj)) ; + BerkeleyDB__Cursor cur = INT2PTR(BerkeleyDB__Cursor, tmp); + cursor_list[i] = cur->cursor ; + } + cursor_list[i] = NULL ; +#if DB_VERSION_MAJOR == 2 + if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, flags, &join_cursor)) == 0){ +#else + if ((db->Status = ((db->dbp)->join)(db->dbp, cursor_list, &join_cursor, flags)) == 0){ +#endif + ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ; + db->open_cursors ++ ; + RETVAL->parent_db = db ; + RETVAL->cursor = join_cursor ; + RETVAL->dbp = db->dbp ; + RETVAL->type = db->type ; + RETVAL->filename = my_strdup(db->filename) ; + RETVAL->compare = db->compare ; + RETVAL->dup_compare = db->dup_compare ; +#ifdef AT_LEAST_DB_3_3 + RETVAL->associated = db->associated ; + RETVAL->secondary_db = db->secondary_db; +#endif + RETVAL->prefix = db->prefix ; + RETVAL->hash = db->hash ; + RETVAL->partial = db->partial ; + RETVAL->doff = db->doff ; + RETVAL->dlen = db->dlen ; + RETVAL->active = TRUE ; +#ifdef ALLOW_RECNO_OFFSET + RETVAL->array_base = db->array_base ; +#endif /* ALLOW_RECNO_OFFSET */ +#ifdef DBM_FILTERING + RETVAL->filtering = FALSE ; + RETVAL->filter_fetch_key = db->filter_fetch_key ; + RETVAL->filter_store_key = db->filter_store_key ; + RETVAL->filter_fetch_value = db->filter_fetch_value ; + RETVAL->filter_store_value = db->filter_store_value ; +#endif + /* RETVAL->info ; */ + hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ; + } + safefree(cursor_list) ; +#endif /* Berkeley DB >= 2.5.2 */ + } + OUTPUT: + RETVAL + +int +ArrayOffset(db) + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CODE: +#ifdef ALLOW_RECNO_OFFSET + RETVAL = db->array_base ? 0 : 1 ; +#else + RETVAL = 0 ; +#endif /* ALLOW_RECNO_OFFSET */ + OUTPUT: + RETVAL + +int +type(db) + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CODE: + RETVAL = db->type ; + OUTPUT: + RETVAL + +int +byteswapped(db) + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CODE: +#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5 + softCrash("byteswapped needs Berkeley DB 2.5 or later") ; +#else +#if DB_VERSION_MAJOR == 2 + RETVAL = db->dbp->byteswapped ; +#else +#ifdef AT_LEAST_DB_3_3 + db->dbp->get_byteswapped(db->dbp, &RETVAL) ; +#else + RETVAL = db->dbp->get_byteswapped(db->dbp) ; +#endif +#endif +#endif + OUTPUT: + RETVAL + +DualType +status(db) + BerkeleyDB::Common db + CODE: + RETVAL = db->Status ; + OUTPUT: + RETVAL + +#ifdef DBM_FILTERING + +#define setFilter(ftype) \ + { \ + if (db->ftype) \ + RETVAL = sv_mortalcopy(db->ftype) ; \ + ST(0) = RETVAL ; \ + if (db->ftype && (code == &PL_sv_undef)) { \ + SvREFCNT_dec(db->ftype) ; \ + db->ftype = NULL ; \ + } \ + else if (code) { \ + if (db->ftype) \ + sv_setsv(db->ftype, code) ; \ + else \ + db->ftype = newSVsv(code) ; \ + } \ + } + + +SV * +filter_fetch_key(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + DBM_setFilter(db->filter_fetch_key, code) ; + +SV * +filter_store_key(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + DBM_setFilter(db->filter_store_key, code) ; + +SV * +filter_fetch_value(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + DBM_setFilter(db->filter_fetch_value, code) ; + +SV * +filter_store_value(db, code) + BerkeleyDB::Common db + SV * code + SV * RETVAL = &PL_sv_undef ; + CODE: + DBM_setFilter(db->filter_store_value, code) ; + +#endif /* DBM_FILTERING */ + +void +partial_set(db, offset, length) + BerkeleyDB::Common db + u_int32_t offset + u_int32_t length + INIT: + ckActive_Database(db->active) ; + PPCODE: + if (GIMME == G_ARRAY) { + XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ; + XPUSHs(sv_2mortal(newSViv(db->doff))) ; + XPUSHs(sv_2mortal(newSViv(db->dlen))) ; + } + db->partial = DB_DBT_PARTIAL ; + db->doff = offset ; + db->dlen = length ; + + +void +partial_clear(db) + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + PPCODE: + if (GIMME == G_ARRAY) { + XPUSHs(sv_2mortal(newSViv(db->partial == DB_DBT_PARTIAL))) ; + XPUSHs(sv_2mortal(newSViv(db->doff))) ; + XPUSHs(sv_2mortal(newSViv(db->dlen))) ; + } + db->partial = + db->doff = + db->dlen = 0 ; + + +#define db_del(db, key, flags) \ + (db->Status = ((db->dbp)->del)(db->dbp, db->txn, &key, flags)) +DualType +db_del(db, key, flags=0) + u_int flags + BerkeleyDB::Common db + DBTKEY key + INIT: + Trace(("db_del db[%p] in [%p] txn[%p] key[%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ; + ckActive_Database(db->active) ; + CurrentDB = db ; + + +#ifdef AT_LEAST_DB_3 +# ifdef AT_LEAST_DB_3_2 +# define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_CONSUME_WAIT)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO)) +# else +# define writeToKey() (flagSet(DB_CONSUME)||flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO)) +# endif +#else +#define writeToKey() (flagSet(DB_GET_BOTH)||flagSet(DB_SET_RECNO)) +#endif +#define db_get(db, key, data, flags) \ + (db->Status = ((db->dbp)->get)(db->dbp, db->txn, &key, &data, flags)) +DualType +db_get(db, key, data, flags=0) + u_int flags + BerkeleyDB::Common db + DBTKEY_B key + DBT_OPT data + CODE: + ckActive_Database(db->active) ; + CurrentDB = db ; + SetPartial(data,db) ; + Trace(("db_get db[%p] in [%p] txn[%p] key [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, flags)) ; + RETVAL = db_get(db, key, data, flags); + Trace((" RETVAL %d\n", RETVAL)); + OUTPUT: + RETVAL + key if (writeToKey()) OutputKey(ST(1), key) ; + data + +#define db_pget(db, key, pkey, data, flags) \ + (db->Status = ((db->dbp)->pget)(db->dbp, db->txn, &key, &pkey, &data, flags)) +DualType +db_pget(db, key, pkey, data, flags=0) + u_int flags + BerkeleyDB::Common db + DBTKEY_B key + DBTKEY_B pkey = NO_INIT + DBT_OPT data + CODE: +#ifndef AT_LEAST_DB_3_3 + softCrash("db_pget needs at least Berkeley DB 3.3"); +#else + Trace(("db_pget db [%p] in [%p] txn [%p] flags [%d]\n", db->dbp, db, db->txn, flags)) ; + ckActive_Database(db->active) ; + CurrentDB = db ; + SetPartial(data,db) ; + DBT_clear(pkey); + RETVAL = db_pget(db, key, pkey, data, flags); + Trace((" RETVAL %d\n", RETVAL)); +#endif + OUTPUT: + RETVAL + key if (writeToKey()) OutputKey(ST(1), key) ; + pkey + data + +#define db_put(db,key,data,flag) \ + (db->Status = (db->dbp->put)(db->dbp,db->txn,&key,&data,flag)) +DualType +db_put(db, key, data, flags=0) + u_int flags + BerkeleyDB::Common db + DBTKEY key + DBT data + CODE: + ckActive_Database(db->active) ; + CurrentDB = db ; + /* SetPartial(data,db) ; */ + Trace(("db_put db[%p] in [%p] txn[%p] key[%.*s] data [%.*s] flags[%d]\n", db->dbp, db, db->txn, key.size, key.data, data.size, data.data, flags)) ; + RETVAL = db_put(db, key, data, flags); + Trace((" RETVAL %d\n", RETVAL)); + OUTPUT: + RETVAL + key if (flagSet(DB_APPEND)) OutputKey(ST(1), key) ; + +#define db_key_range(db, key, range, flags) \ + (db->Status = ((db->dbp)->key_range)(db->dbp, db->txn, &key, &range, flags)) +DualType +db_key_range(db, key, less, equal, greater, flags=0) + u_int32_t flags + BerkeleyDB::Common db + DBTKEY_B key + double less = 0.0 ; + double equal = 0.0 ; + double greater = 0.0 ; + CODE: + { +#ifndef AT_LEAST_DB_3_1 + softCrash("key_range needs Berkeley DB 3.1.x or later") ; +#else + DB_KEY_RANGE range ; + range.less = range.equal = range.greater = 0.0 ; + ckActive_Database(db->active) ; + CurrentDB = db ; + RETVAL = db_key_range(db, key, range, flags); + if (RETVAL == 0) { + less = range.less ; + equal = range.equal; + greater = range.greater; + } +#endif + } + OUTPUT: + RETVAL + less + equal + greater + + +#define db_fd(d, x) (db->Status = (db->dbp->fd)(db->dbp, &x)) +DualType +db_fd(db) + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CODE: + CurrentDB = db ; + db_fd(db, RETVAL) ; + OUTPUT: + RETVAL + + +#define db_sync(db, fl) (db->Status = (db->dbp->sync)(db->dbp, fl)) +DualType +db_sync(db, flags=0) + u_int flags + BerkeleyDB::Common db + INIT: + ckActive_Database(db->active) ; + CurrentDB = db ; + +void +_Txn(db, txn=NULL) + BerkeleyDB::Common db + BerkeleyDB::Txn txn + INIT: + ckActive_Database(db->active) ; + CODE: + if (txn) { + Trace(("_Txn[%p] in[%p] active [%d]\n", txn->txn, txn, txn->active)); + ckActive_Transaction(txn->active) ; + db->txn = txn->txn ; + } + else { + Trace(("_Txn[undef] \n")); + db->txn = NULL ; + } + + +#define db_truncate(db, countp, flags) \ + (db->Status = ((db->dbp)->truncate)(db->dbp, db->txn, &countp, flags)) +DualType +truncate(db, countp, flags=0) + BerkeleyDB::Common db + u_int32_t countp + u_int32_t flags + INIT: + ckActive_Database(db->active) ; + CODE: +#ifndef AT_LEAST_DB_3_3 + softCrash("truncate needs Berkeley DB 3.3 or later") ; +#else + CurrentDB = db ; + RETVAL = db_truncate(db, countp, flags); +#endif + OUTPUT: + RETVAL + countp + +#ifdef AT_LEAST_DB_4_1 +# define db_associate(db, sec, cb, flags)\ + (db->Status = ((db->dbp)->associate)(db->dbp, NULL, sec->dbp, &cb, flags)) +#else +# define db_associate(db, sec, cb, flags)\ + (db->Status = ((db->dbp)->associate)(db->dbp, sec->dbp, &cb, flags)) +#endif +DualType +associate(db, secondary, callback, flags=0) + BerkeleyDB::Common db + BerkeleyDB::Common secondary + SV* callback + u_int32_t flags + INIT: + ckActive_Database(db->active) ; + CODE: +#ifndef AT_LEAST_DB_3_3 + softCrash("associate needs Berkeley DB 3.3 or later") ; +#else + CurrentDB = db ; + /* db->associated = newSVsv(callback) ; */ + secondary->associated = newSVsv(callback) ; + /* secondary->dbp->app_private = secondary->associated ; */ + secondary->secondary_db = TRUE; + RETVAL = db_associate(db, secondary, associate_cb, flags); +#endif + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB::Cursor PACKAGE = BerkeleyDB::Cursor PREFIX = cu_ + +BerkeleyDB::Cursor::Raw +_c_dup(db, flags=0) + u_int32_t flags + BerkeleyDB::Cursor db + BerkeleyDB::Cursor RETVAL = NULL ; + INIT: + CurrentDB = db->parent_db ; + ckActive_Database(db->active) ; + CODE: + { +#ifndef AT_LEAST_DB_3 + softCrash("c_dup needs at least Berkeley DB 3.0.x"); +#else + DBC * newcursor ; + db->Status = ((db->cursor)->c_dup)(db->cursor, &newcursor, flags) ; + if (db->Status == 0){ + ZMALLOC(RETVAL, BerkeleyDB__Cursor_type) ; + db->parent_db->open_cursors ++ ; + RETVAL->parent_db = db->parent_db ; + RETVAL->cursor = newcursor ; + RETVAL->dbp = db->dbp ; + RETVAL->type = db->type ; + RETVAL->recno_or_queue = db->recno_or_queue ; + RETVAL->filename = my_strdup(db->filename) ; + RETVAL->compare = db->compare ; + RETVAL->dup_compare = db->dup_compare ; +#ifdef AT_LEAST_DB_3_3 + RETVAL->associated = db->associated ; +#endif + RETVAL->prefix = db->prefix ; + RETVAL->hash = db->hash ; + RETVAL->partial = db->partial ; + RETVAL->doff = db->doff ; + RETVAL->dlen = db->dlen ; + RETVAL->active = TRUE ; +#ifdef ALLOW_RECNO_OFFSET + RETVAL->array_base = db->array_base ; +#endif /* ALLOW_RECNO_OFFSET */ +#ifdef DBM_FILTERING + RETVAL->filtering = FALSE ; + RETVAL->filter_fetch_key = db->filter_fetch_key ; + RETVAL->filter_store_key = db->filter_store_key ; + RETVAL->filter_fetch_value = db->filter_fetch_value ; + RETVAL->filter_store_value = db->filter_store_value ; +#endif /* DBM_FILTERING */ + /* RETVAL->info ; */ + hash_store_iv("BerkeleyDB::Term::Cursor", (char *)RETVAL, 1) ; + } +#endif + } + OUTPUT: + RETVAL + +DualType +_c_close(db) + BerkeleyDB::Cursor db + INIT: + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ; + CODE: + RETVAL = db->Status = + ((db->cursor)->c_close)(db->cursor) ; + db->active = FALSE ; + if (db->parent_db->open_cursors) + -- db->parent_db->open_cursors ; + OUTPUT: + RETVAL + +void +_DESTROY(db) + BerkeleyDB::Cursor db + CODE: + CurrentDB = db->parent_db ; + Trace(("In BerkeleyDB::Cursor::_DESTROY db %d dirty=%d active=%d\n", db, PL_dirty, db->active)); + hash_delete("BerkeleyDB::Term::Cursor", (char *)db) ; + if (db->active) + ((db->cursor)->c_close)(db->cursor) ; + if (db->parent_db->open_cursors) + -- db->parent_db->open_cursors ; + Safefree(db->filename) ; + Safefree(db) ; + Trace(("End of BerkeleyDB::Cursor::_DESTROY\n")) ; + +DualType +status(db) + BerkeleyDB::Cursor db + CODE: + RETVAL = db->Status ; + OUTPUT: + RETVAL + + +#define cu_c_del(c,f) (c->Status = ((c->cursor)->c_del)(c->cursor,f)) +DualType +cu_c_del(db, flags=0) + int flags + BerkeleyDB::Cursor db + INIT: + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + OUTPUT: + RETVAL + + +#define cu_c_get(c,k,d,f) (c->Status = (c->cursor->c_get)(c->cursor,&k,&d,f)) +DualType +cu_c_get(db, key, data, flags=0) + int flags + BerkeleyDB::Cursor db + DBTKEY_B key + DBT_B data + INIT: + Trace(("c_get db [%p] in [%p] flags [%d]\n", db->dbp, db, flags)) ; + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + SetPartial(data,db) ; + Trace(("c_get end\n")) ; + OUTPUT: + RETVAL + key + data if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ; + +#define cu_c_pget(c,k,p,d,f) (c->Status = (c->secondary_db ? (c->cursor->c_pget)(c->cursor,&k,&p,&d,f) : EINVAL)) +DualType +cu_c_pget(db, key, pkey, data, flags=0) + int flags + BerkeleyDB::Cursor db + DBTKEY_B key + DBTKEY_B pkey = NO_INIT + DBT_B data + CODE: +#ifndef AT_LEAST_DB_3_3 + softCrash("db_c_pget needs at least Berkeley DB 3.3"); +#else + Trace(("c_pget db [%d] flags [%d]\n", db, flags)) ; + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + SetPartial(data,db) ; + DBT_clear(pkey); + RETVAL = cu_c_pget(db, key, pkey, data, flags); + Trace(("c_pget end\n")) ; +#endif + OUTPUT: + RETVAL + key + pkey + data if (! flagSet(DB_JOIN_ITEM)) OutputValue_B(ST(2), data) ; + + + +#define cu_c_put(c,k,d,f) (c->Status = (c->cursor->c_put)(c->cursor,&k,&d,f)) +DualType +cu_c_put(db, key, data, flags=0) + int flags + BerkeleyDB::Cursor db + DBTKEY key + DBT data + INIT: + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + /* SetPartial(data,db) ; */ + OUTPUT: + RETVAL + +#define cu_c_count(c,p,f) (c->Status = (c->cursor->c_count)(c->cursor,&p,f)) +DualType +cu_c_count(db, count, flags=0) + int flags + BerkeleyDB::Cursor db + u_int32_t count = NO_INIT + CODE: +#ifndef AT_LEAST_DB_3_1 + softCrash("c_count needs at least Berkeley DB 3.1.x"); +#else + Trace(("c_get count [%d] flags [%d]\n", db, flags)) ; + CurrentDB = db->parent_db ; + ckActive_Cursor(db->active) ; + RETVAL = cu_c_count(db, count, flags) ; + Trace((" c_count got %d duplicates\n", count)) ; +#endif + OUTPUT: + RETVAL + count + +MODULE = BerkeleyDB::TxnMgr PACKAGE = BerkeleyDB::TxnMgr PREFIX = xx_ + +BerkeleyDB::Txn::Raw +_txn_begin(txnmgr, pid=NULL, flags=0) + u_int32_t flags + BerkeleyDB::TxnMgr txnmgr + BerkeleyDB::Txn pid + CODE: + { + DB_TXN *txn ; + DB_TXN *p_id = NULL ; +#if DB_VERSION_MAJOR == 2 + if (txnmgr->env->Env->tx_info == NULL) + softCrash("Transaction Manager not enabled") ; +#endif + if (pid) + p_id = pid->txn ; + txnmgr->env->TxnMgrStatus = +#if DB_VERSION_MAJOR == 2 + txn_begin(txnmgr->env->Env->tx_info, p_id, &txn) ; +#else +# ifdef AT_LEAST_DB_4 + txnmgr->env->Env->txn_begin(txnmgr->env->Env, p_id, &txn, flags) ; +# else + txn_begin(txnmgr->env->Env, p_id, &txn, flags) ; +# endif +#endif + if (txnmgr->env->TxnMgrStatus == 0) { + ZMALLOC(RETVAL, BerkeleyDB_Txn_type) ; + RETVAL->txn = txn ; + RETVAL->active = TRUE ; + Trace(("_txn_begin created txn [%d] in [%d]\n", txn, RETVAL)); + hash_store_iv("BerkeleyDB::Term::Txn", (char *)RETVAL, 1) ; + } + else + RETVAL = NULL ; + } + OUTPUT: + RETVAL + + +DualType +status(mgr) + BerkeleyDB::TxnMgr mgr + CODE: + RETVAL = mgr->env->TxnMgrStatus ; + OUTPUT: + RETVAL + + +void +_DESTROY(mgr) + BerkeleyDB::TxnMgr mgr + CODE: + Trace(("In BerkeleyDB::TxnMgr::DESTROY dirty=%d\n", PL_dirty)) ; + Safefree(mgr) ; + Trace(("End of BerkeleyDB::TxnMgr::DESTROY\n")) ; + +DualType +txn_close(txnp) + BerkeleyDB::TxnMgr txnp + NOT_IMPLEMENTED_YET + + +#if DB_VERSION_MAJOR == 2 +# define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env->tx_info, k, m) +#else +# ifdef AT_LEAST_DB_4 +# define xx_txn_checkpoint(e,k,m,f) e->env->Env->txn_checkpoint(e->env->Env, k, m, f) +# else +# ifdef AT_LEAST_DB_3_1 +# define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m, 0) +# else +# define xx_txn_checkpoint(t,k,m,f) txn_checkpoint(t->env->Env, k, m) +# endif +# endif +#endif +DualType +xx_txn_checkpoint(txnp, kbyte, min, flags=0) + BerkeleyDB::TxnMgr txnp + long kbyte + long min + u_int32_t flags + +HV * +txn_stat(txnp) + BerkeleyDB::TxnMgr txnp + HV * RETVAL = NULL ; + CODE: + { + DB_TXN_STAT * stat ; +#ifdef AT_LEAST_DB_4 + if(txnp->env->Env->txn_stat(txnp->env->Env, &stat, 0) == 0) { +#else +# ifdef AT_LEAST_DB_3_3 + if(txn_stat(txnp->env->Env, &stat) == 0) { +# else +# if DB_VERSION_MAJOR == 2 + if(txn_stat(txnp->env->Env->tx_info, &stat, safemalloc) == 0) { +# else + if(txn_stat(txnp->env->Env, &stat, safemalloc) == 0) { +# endif +# endif +#endif + RETVAL = (HV*)sv_2mortal((SV*)newHV()) ; + hv_store_iv(RETVAL, "st_time_ckp", stat->st_time_ckp) ; + hv_store_iv(RETVAL, "st_last_txnid", stat->st_last_txnid) ; + hv_store_iv(RETVAL, "st_maxtxns", stat->st_maxtxns) ; + hv_store_iv(RETVAL, "st_naborts", stat->st_naborts) ; + hv_store_iv(RETVAL, "st_nbegins", stat->st_nbegins) ; + hv_store_iv(RETVAL, "st_ncommits", stat->st_ncommits) ; + hv_store_iv(RETVAL, "st_nactive", stat->st_nactive) ; +#if DB_VERSION_MAJOR > 2 + hv_store_iv(RETVAL, "st_maxnactive", stat->st_maxnactive) ; + hv_store_iv(RETVAL, "st_regsize", stat->st_regsize) ; + hv_store_iv(RETVAL, "st_region_wait", stat->st_region_wait) ; + hv_store_iv(RETVAL, "st_region_nowait", stat->st_region_nowait) ; +#endif + safefree(stat) ; + } + } + OUTPUT: + RETVAL + + +BerkeleyDB::TxnMgr +txn_open(dir, flags, mode, dbenv) + int flags + const char * dir + int mode + BerkeleyDB::Env dbenv + NOT_IMPLEMENTED_YET + + +MODULE = BerkeleyDB::Txn PACKAGE = BerkeleyDB::Txn PREFIX = xx_ + +DualType +status(tid) + BerkeleyDB::Txn tid + CODE: + RETVAL = tid->Status ; + OUTPUT: + RETVAL + +int +_DESTROY(tid) + BerkeleyDB::Txn tid + CODE: + Trace(("In BerkeleyDB::Txn::_DESTROY txn [%d] active [%d] dirty=%d\n", tid->txn, tid->active, PL_dirty)) ; + if (tid->active) +#ifdef AT_LEAST_DB_4 + tid->txn->abort(tid->txn) ; +#else + txn_abort(tid->txn) ; +#endif + RETVAL = (int)tid ; + hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ; + Safefree(tid) ; + Trace(("End of BerkeleyDB::Txn::DESTROY\n")) ; + OUTPUT: + RETVAL + +#define xx_txn_unlink(d,f,e) txn_unlink(d,f,&(e->Env)) +DualType +xx_txn_unlink(dir, force, dbenv) + const char * dir + int force + BerkeleyDB::Env dbenv + NOT_IMPLEMENTED_YET + +#ifdef AT_LEAST_DB_4 +# define xx_txn_prepare(t) (t->Status = t->txn->prepare(t->txn, 0)) +#else +# ifdef AT_LEAST_DB_3_3 +# define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn, 0)) +# else +# define xx_txn_prepare(t) (t->Status = txn_prepare(t->txn)) +# endif +#endif +DualType +xx_txn_prepare(tid) + BerkeleyDB::Txn tid + INIT: + ckActive_Transaction(tid->active) ; + +#ifdef AT_LEAST_DB_4 +# define _txn_commit(t,flags) (t->Status = t->txn->commit(t->txn, flags)) +#else +# if DB_VERSION_MAJOR == 2 +# define _txn_commit(t,flags) (t->Status = txn_commit(t->txn)) +# else +# define _txn_commit(t, flags) (t->Status = txn_commit(t->txn, flags)) +# endif +#endif +DualType +_txn_commit(tid, flags=0) + u_int32_t flags + BerkeleyDB::Txn tid + INIT: + ckActive_Transaction(tid->active) ; + hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ; + tid->active = FALSE ; + +#ifdef AT_LEAST_DB_4 +# define _txn_abort(t) (t->Status = t->txn->abort(t->txn)) +#else +# define _txn_abort(t) (t->Status = txn_abort(t->txn)) +#endif +DualType +_txn_abort(tid) + BerkeleyDB::Txn tid + INIT: + ckActive_Transaction(tid->active) ; + hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ; + tid->active = FALSE ; + +#ifdef AT_LEAST_DB_4 +# define _txn_discard(t,f) (t->Status = t->txn->discard(t->txn, f)) +#else +# ifdef AT_LEAST_DB_3_3_4 +# define _txn_discard(t,f) (t->Status = txn_discard(t->txn, f)) +# else +# define _txn_discard(t,f) (int)softCrash("txn_discard needs Berkeley DB 3.3.4 or better") ; +# endif +#endif +DualType +_txn_discard(tid, flags=0) + BerkeleyDB::Txn tid + u_int32_t flags + INIT: + ckActive_Transaction(tid->active) ; + hash_delete("BerkeleyDB::Term::Txn", (char *)tid) ; + tid->active = FALSE ; + +#ifdef AT_LEAST_DB_4 +# define xx_txn_id(t) t->txn->id(t->txn) +#else +# define xx_txn_id(t) txn_id(t->txn) +#endif +u_int32_t +xx_txn_id(tid) + BerkeleyDB::Txn tid + +MODULE = BerkeleyDB::_tiedHash PACKAGE = BerkeleyDB::_tiedHash + +int +FIRSTKEY(db) + BerkeleyDB::Common db + CODE: + { + DBTKEY key ; + DBT value ; + DBC * cursor ; + + /* + TODO! + set partial value to 0 - to eliminate the retrieval of + the value need to store any existing partial settings & + restore at the end. + + */ + CurrentDB = db ; + DBT_clear(key) ; + DBT_clear(value) ; + /* If necessary create a cursor for FIRSTKEY/NEXTKEY use */ + if (!db->cursor && + (db->Status = db_cursor(db, db->txn, &cursor, 0)) == 0 ) + db->cursor = cursor ; + + if (db->cursor) + RETVAL = (db->Status) = + ((db->cursor)->c_get)(db->cursor, &key, &value, DB_FIRST); + else + RETVAL = db->Status ; + /* check for end of cursor */ + if (RETVAL == DB_NOTFOUND) { + ((db->cursor)->c_close)(db->cursor) ; + db->cursor = NULL ; + } + ST(0) = sv_newmortal(); + OutputKey(ST(0), key) + } + + + +int +NEXTKEY(db, key) + BerkeleyDB::Common db + DBTKEY key = NO_INIT + CODE: + { + DBT value ; + + CurrentDB = db ; + DBT_clear(key) ; + DBT_clear(value) ; + key.flags = 0 ; + RETVAL = (db->Status) = + ((db->cursor)->c_get)(db->cursor, &key, &value, DB_NEXT); + + /* check for end of cursor */ + if (RETVAL == DB_NOTFOUND) { + ((db->cursor)->c_close)(db->cursor) ; + db->cursor = NULL ; + } + ST(0) = sv_newmortal(); + OutputKey(ST(0), key) + } + +MODULE = BerkeleyDB::_tiedArray PACKAGE = BerkeleyDB::_tiedArray + +I32 +FETCHSIZE(db) + BerkeleyDB::Common db + CODE: + CurrentDB = db ; + RETVAL = GetArrayLength(db) ; + OUTPUT: + RETVAL + + +MODULE = BerkeleyDB PACKAGE = BerkeleyDB + +BOOT: + { + SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; + SV * version_sv = perl_get_sv("BerkeleyDB::db_version", GV_ADD|GV_ADDMULTI) ; + SV * ver_sv = perl_get_sv("BerkeleyDB::db_ver", GV_ADD|GV_ADDMULTI) ; + int Major, Minor, Patch ; + (void)db_version(&Major, &Minor, &Patch) ; + /* Check that the versions of db.h and libdb.a are the same */ + if (Major != DB_VERSION_MAJOR || Minor != DB_VERSION_MINOR + || Patch != DB_VERSION_PATCH) + croak("\nBerkeleyDB needs compatible versions of libdb & db.h\n\tyou have db.h version %d.%d.%d and libdb version %d.%d.%d\n", + DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, + Major, Minor, Patch) ; + + if (Major < 2 || (Major == 2 && Minor < 6)) + { + croak("BerkeleyDB needs Berkeley DB 2.6 or greater. This is %d.%d.%d\n", + Major, Minor, Patch) ; + } + sv_setpvf(version_sv, "%d.%d", Major, Minor) ; + sv_setpvf(ver_sv, "%d.%03d%03d", Major, Minor, Patch) ; + sv_setpv(sv_err, ""); + + DBT_clear(empty) ; + empty.data = &zero ; + empty.size = sizeof(db_recno_t) ; + empty.flags = 0 ; + + } + diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm b/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm new file mode 100644 index 00000000000..ba9a9c0085d --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm @@ -0,0 +1,8 @@ + +package BerkeleyDB::Btree ; + +# This file is only used for MLDBM + +use BerkeleyDB ; + +1 ; diff --git a/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm b/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm new file mode 100644 index 00000000000..8e7bc7e78c7 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm @@ -0,0 +1,8 @@ + +package BerkeleyDB::Hash ; + +# This file is only used for MLDBM + +use BerkeleyDB ; + +1 ; diff --git a/storage/bdb/perl/BerkeleyDB/Changes b/storage/bdb/perl/BerkeleyDB/Changes new file mode 100644 index 00000000000..cbeb1a34d73 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/Changes @@ -0,0 +1,167 @@ +Revision history for Perl extension BerkeleyDB. + +0.20 2nd September 2002 + + * More support for building with Berkeley DB 4.1.x + * db->get & db->pget used the wrong output macro for DBM filters + bug spotted by Aaron Ross. + * db_join didn't keep a reference to the cursors it was joining. + Spotted by Winton Davies. + +0.19 5th June 2002 + * Removed the targets that used mkconsts from Makefile.PL. They relied + on a module that is not available in all versions of Perl. + * added support for env->set_verbose + * added support for db->truncate + * added support for db->rename via BerkeleyDB::db_rename + * added support for db->verify via BerkeleyDB::db_verify + * added support for db->associate, db->pget & cursor->c_pget + * Builds with Berkeley DB 4.1.x + + +0.18 6th January 2002 + * Dropped support for ErrFile as a file handle. It was proving too + difficult to get at the underlying FILE * in XS. + Reported by Jonas Smedegaard (Debian powerpc) & Kenneth Olwing (Win32) + * Fixed problem with abort macro in XSUB.h clashing with txn abort + method in Berkeley DB 4.x -- patch supplied by Kenneth Olwing. + * DB->set_alloc was getting called too late in BerkeleyDB.xs. + This was causing problems with ActivePerl -- problem reported + by Kenneth Olwing. + * When opening a queue, the Len proprty set the DB_PAD flag. + Should have been DB_FIXEDLEN. Fix provided by Kenneth Olwing. + * Test harness fixes from Kenneth Olwing. + +0.17 23 September 2001 + * Fixed a bug in BerkeleyDB::Recno - reported by Niklas Paulsson. + * Added log_archive - patch supplied by Benjamin Holzman + * Added txn_discard + * Builds with Berkeley DB 4.0.x + +0.16 1 August 2001 + * added support for Berkeley DB 3.3.x (but no support for any of the + new features just yet) + +0.15 26 April 2001 + * Fixed a bug in the processing of the flags options in + db_key_range. + * added support for set_lg_max & set_lg_bsize + * allow DB_TMP_DIR and DB_TEMP_DIR + * the -Filename parameter to BerkeleyDB::Queue didn't work. + * added symbol DB_CONSUME_WAIT + +0.14 21st January 2001 + * Silenced the warnings when build with a 64-bit Perl. + * Can now build with DB 3.2.3h (part of MySQL). The test harness + takes an age to do the queue test, but it does eventually pass. + * Mentioned the problems that occur when perl is built with sfio. + +0.13 15th January 2001 + * Added support to allow this module to build with Berkeley DB 3.2 + * Updated dbinfo to support Berkeley DB 3.1 & 3.2 file format + changes. + * Documented the Solaris 2.7 core dump problem in README. + * Tidied up the test harness to fix a problem on Solaris where the + "fred" directory wasn't being deleted when it should have been. + * two calls to "open" clashed with a win32 macro. + * size argument for hash_cb is different for Berkeley DB 3.x + * Documented the issue of building on Linux. + * Added -Server, -CacheSize & -LockDetect options + [original patch supplied by Graham Barr] + * Added support for set_mutexlocks, c_count, set_q_extentsize, + key_range, c_dup + * Dropped the "attempted to close a Cursor with an open transaction" + error in c_close. The correct behaviour is that the cursor + should be closed before committing/aborting the transaction. + +0.12 2nd August 2000 + * Serious bug with get fixed. Spotted by Sleepycat. + * Added hints file for Solaris & Irix (courtesy of Albert Chin-A-Young) + +0.11 4th June 2000 + * When built with Berkeley Db 3.x there can be a clash with the close + macro. + * Typo in the definition of DB_WRITECURSOR + * The flags parameter wasn't getting sent to db_cursor + * Plugged small memory leak in db_cursor (DESTROY wasn't freeing + memory) + * Can be built with Berkeley DB 3.1 + +0.10 8th December 1999 + * The DESTROY method was missing for BerkeleyDB::Env. This resulted in + a memory leak. Fixed. + * If opening an environment or database failed, there was a small + memory leak. This has been fixed. + * A thread-enabled Perl it could core when a database was closed. + Problem traced to the strdup function. + +0.09 29th November 1999 + * the queue.t & subdb.t test harnesses were outputting a few + spurious warnings. This has been fixed. + +0.08 28nd November 1999 + * More documentation updates + * Changed reference to files in /tmp in examples.t + * Fixed a typo in softCrash that caused problems when building + with a thread-enabled Perl. + * BerkeleyDB::Error wasn't initialised properly. + * ANSI-ified all the static C functions in BerkeleyDB.xs + * Added support for the following DB 3.x features: + + The Queue database type + + db_remove + + subdatabases + + db_stat for Hash & Queue + +0.07 21st September 1999 + * Numerous small bug fixes. + * Added support for sorting duplicate values DB_DUPSORT. + * Added support for DB_GET_BOTH & DB_NEXT_DUP. + * Added get_dup (from DB_File). + * beefed up the documentation. + * Forgot to add the DB_INIT_CDB in BerkeleyDB.pm in previous release. + * Merged the DBM Filter code from DB_File into BerkeleyDB. + * Fixed a nasty bug where a closed transaction was still used with + with dp_put, db_get etc. + * Added logic to gracefully close everything whenever a fatal error + happens. Previously the plug was just pulled. + * It is now a fatal error to explicitly close an environment if there + is still an open database; a database when there are open cursors or + an open transaction; and a cursor if there is an open transaction. + Using object destruction doesn't have this issue, as object + references will ensure everything gets closed in the correct order. + * The BOOT code now checks that the version of db.h & libdb are the + same - this seems to be a common problem on Linux. + * MLDBM support added. + * Support for the new join cursor added. + * Builds with Berkeley DB 3.x + * Updated dbinfo for Berkeley DB 3.x file formats. + * Deprecated the TxnMgr class. As with Berkeley DB version 3, + txn_begin etc are now accessed via the environment object. + +0.06 19 December 1998 + * Minor modifications to get the module to build with DB 2.6.x + * Added support for DB 2.6.x's Concurrent Access Method, DB_INIT_CDB. + +0.05 9 November 1998 + * Added a note to README about how to build Berkeley DB 2.x + when using HP-UX. + * Minor modifications to get the module to build with DB 2.5.x + +0.04 19 May 1998 + * Define DEFSV & SAVE_DEFSV if not already defined. This allows + the module to be built with Perl 5.004_04. + +0.03 5 May 1998 + * fixed db_get with DB_SET_RECNO + * fixed c_get with DB_SET_RECNO and DB_GET_RECNO + * implemented BerkeleyDB::Unknown + * implemented BerkeleyDB::Recno, including push, pop etc + modified the txn support. + +0.02 30 October 1997 + * renamed module to BerkeleyDB + * fixed a few bugs & added more tests + +0.01 23 October 1997 + * first alpha release as BerkDB. + diff --git a/storage/bdb/perl/BerkeleyDB/MANIFEST b/storage/bdb/perl/BerkeleyDB/MANIFEST new file mode 100644 index 00000000000..7da51ef7d7c --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/MANIFEST @@ -0,0 +1,56 @@ +BerkeleyDB.pm +BerkeleyDB.pod +BerkeleyDB.pod.P +BerkeleyDB.xs +BerkeleyDB/Btree.pm +BerkeleyDB/Hash.pm +Changes +config.in +constants.h +constants.xs +dbinfo +hints/dec_osf.pl +hints/solaris.pl +hints/irix_6_5.pl +Makefile.PL +MANIFEST +mkconsts +mkpod +ppport.h +README +t/btree.t +t/db-3.0.t +t/db-3.1.t +t/db-3.2.t +t/db-3.3.t +t/destroy.t +t/env.t +t/examples.t +t/examples.t.T +t/examples3.t +t/examples3.t.T +t/filter.t +t/hash.t +t/join.t +t/mldbm.t +t/queue.t +t/recno.t +t/strict.t +t/subdb.t +t/txn.t +t/unknown.t +t/util.pm +Todo +typemap +patches/5.004 +patches/5.004_01 +patches/5.004_02 +patches/5.004_03 +patches/5.004_04 +patches/5.004_05 +patches/5.005 +patches/5.005_01 +patches/5.005_02 +patches/5.005_03 +patches/5.6.0 +scan diff --git a/storage/bdb/perl/BerkeleyDB/Makefile.PL b/storage/bdb/perl/BerkeleyDB/Makefile.PL new file mode 100644 index 00000000000..86da9a845af --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/Makefile.PL @@ -0,0 +1,123 @@ +#! perl -w + +# It should not be necessary to edit this file. The configuration for +# BerkeleyDB is controlled from the file config.in + + +BEGIN { die "BerkeleyDB needs Perl 5.004_04 or greater" if $] < 5.004_04 ; } + +use strict ; +use ExtUtils::MakeMaker ; +use Config ; + +# Check for the presence of sfio +if ($Config{'d_sfio'}) { + print <<EOM; + +WARNING: Perl seems to have been built with SFIO support enabled. + Please read the SFIO Notes in the README file. + +EOM +} + +my $LIB_DIR ; +my $INC_DIR ; +my $DB_NAME ; +my $LIBS ; + +ParseCONFIG() ; + +if (defined $DB_NAME) + { $LIBS = $DB_NAME } +else { + if ($^O eq 'MSWin32') + { $LIBS = '-llibdb' } + else + { $LIBS = '-ldb' } +} + +# OS2 is a special case, so check for it now. +my $OS2 = "" ; +$OS2 = "-DOS2" if $^O eq 'os2' ; + +WriteMakefile( + NAME => 'BerkeleyDB', + LIBS => ["-L${LIB_DIR} $LIBS"], + #MAN3PODS => {}, # Pods will be built by installman. + INC => "-I$INC_DIR", + VERSION_FROM => 'BerkeleyDB.pm', + XSPROTOARG => '-noprototypes', + DEFINE => "$OS2", + #'macro' => { INSTALLDIRS => 'perl' }, + 'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'}, + ($] >= 5.005 + ? (ABSTRACT_FROM => 'BerkeleyDB.pod', + AUTHOR => 'Paul Marquess <Paul.Marquess@btinternet.com>') + : () + ), + ); + + +sub MY::postamble { + ' +$(NAME).pod: $(NAME).pod.P t/examples.t.T t/examples3.t.T mkpod + perl ./mkpod + +$(NAME).xs: typemap + $(TOUCH) $(NAME).xs + +Makefile: config.in + + +' ; +} + +sub ParseCONFIG +{ + my ($k, $v) ; + my @badkey = () ; + my %Info = () ; + my @Options = qw( INCLUDE LIB DBNAME ) ; + my %ValidOption = map {$_, 1} @Options ; + my %Parsed = %ValidOption ; + my $CONFIG = 'config.in' ; + + print "Parsing $CONFIG...\n" ; + + # DBNAME is optional, so pretend it has been parsed. + delete $Parsed{'DBNAME'} ; + + open(F, "$CONFIG") or die "Cannot open file $CONFIG: $!\n" ; + while (<F>) { + s/^\s*|\s*$//g ; + next if /^\s*$/ or /^\s*#/ ; + s/\s*#\s*$// ; + + ($k, $v) = split(/\s+=\s+/, $_, 2) ; + $k = uc $k ; + if ($ValidOption{$k}) { + delete $Parsed{$k} ; + $Info{$k} = $v ; + } + else { + push(@badkey, $k) ; + } + } + close F ; + + print "Unknown keys in $CONFIG ignored [@badkey]\n" + if @badkey ; + + # check parsed values + my @missing = () ; + die "The following keys are missing from $CONFIG file: [@missing]\n" + if @missing = keys %Parsed ; + + $INC_DIR = $ENV{'BERKELEYDB_INCLUDE'} || $Info{'INCLUDE'} ; + $LIB_DIR = $ENV{'BERKELEYDB_LIB'} || $Info{'LIB'} ; + $DB_NAME = $Info{'DBNAME'} if defined $Info{'DBNAME'} ; + print "Looks Good.\n" ; + +} + +# end of file Makefile.PL diff --git a/storage/bdb/perl/BerkeleyDB/README b/storage/bdb/perl/BerkeleyDB/README new file mode 100644 index 00000000000..a600e313193 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/README @@ -0,0 +1,484 @@ + BerkeleyDB + + Version 0.20 + + 2nd Sept 2002 + + Copyright (c) 1997-2002 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. + + +DESCRIPTION +----------- + +BerkeleyDB is a module which allows Perl programs to make use of the +facilities provided by Berkeley DB version 2 or greater. (Note: if +you want to use version 1 of Berkeley DB with Perl you need the DB_File +module). + +Berkeley DB is a C library which provides a consistent interface to a +number of database formats. BerkeleyDB provides an interface to all +four of the database types (hash, btree, queue and recno) currently +supported by Berkeley DB. + +For further details see the documentation in the file BerkeleyDB.pod. + +PREREQUISITES +------------- + +Before you can build BerkeleyDB you need to have the following +installed on your system: + + * Perl 5.004_04 or greater. + + * Berkeley DB Version 2.6.4 or greater + + The official web site for Berkeley DB is http://www.sleepycat.com + + The latest version of Berkeley DB is always available there. It + is recommended that you use the most recent version available at + the Sleepycat site. + + The one exception to this advice is where you want to use BerkeleyDB + to access database files created by a third-party application, + like Sendmail. In these cases you must build BerkeleyDB with a + compatible version of Berkeley DB. + + +BUILDING THE MODULE +------------------- + +Assuming you have met all the prerequisites, building the module should +be relatively straightforward. + +Step 1 : If you are running Solaris 2.5, 2.7 or HP-UX 10 read either + the Solaris Notes or HP-UX Notes sections below. + If you are running Linux please read the Linux Notes section + before proceeding. + + +Step 2 : Edit the file config.in to suit you local installation. + Instructions are given in the file. + +Step 3 : Build and test the module using this sequence of commands: + + perl Makefile.PL + make + make test + +INSTALLATION +------------ + + make install + +TROUBLESHOOTING +=============== + +Here are some of the problems that people encounter when building BerkeleyDB. + +Missing db.h or libdb.a +----------------------- + +If you get an error like this: + + cc -c -I./libraries/ -Dbool=char -DHAS_BOOL -I/usr/local/include -O2 + -DVERSION=\"0.07\" -DXS_VERSION=\"0.07\" -fpic + -I/usr/local/lib/perl5/5.00503/i586-linux/CORE BerkeleyDB.c + BerkeleyDB.xs:52: db.h: No such file or directory + +or this: + + cc -c -I./libraries/2.7.5 -Dbool=char -DHAS_BOOL -I/usr/local/include -O2 + -DVERSION=\"0.07\" -DXS_VERSION=\"0.07\" -fpic + -I/usr/local/lib/perl5/5.00503/i586-linux/CORE BerkeleyDB.c + LD_RUN_PATH="/lib" cc -o blib/arch/auto/BerkeleyDB/BerkeleyDB.so -shared + -L/usr/local/lib BerkeleyDB.o + -L/home/paul/perl/ext/BerkDB/BerkeleyDB/libraries -ldb + ld: cannot open -ldb: No such file or directory + +This symptom can imply: + + 1. You don't have Berkeley DB installed on your system at all. + Solution: get & install Berkeley DB. + + 2. You do have Berkeley DB installed, but it isn't in a standard place. + Solution: Edit config.in and set the LIB and INCLUDE variables to point + to the directories where libdb.a and db.h are installed. + +#error db.h is not for Berkeley DB at all. +------------------------------------------ + +If you get the error above when building this module it means that there +is a file called "db.h" on your system that isn't the one that comes +with Berkeley DB. + +Options: + + 1. You don't have Berkeley DB installed on your system at all. + Solution: get & install Berkeley DB. + + 2. Edit config.in and make sure the INCLUDE variable points to the + directory where the Berkeley DB file db.h is installed. + + 3. If option 2 doesn't work, try tempoarily renaming the db.h file + that is causing the error. + +#error db.h is for Berkeley DB 1.x - need at least Berkeley DB 2.6.4 +-------------------------------------------------------------------- + +The error above will occur if there is a copy of the Berkeley DB 1.x +file db.h on your system. + +This error will happen when + + 1. you only have Berkeley DB version 1 on your system. + Solution: get & install a newer version of Berkeley DB. + + 2. you have both version 1 and a later version of Berkeley DB + installed on your system. When building BerkeleyDB it attempts to + use the db.h for Berkeley DB version 1. + Solution: Edit config.in and set the LIB and INCLUDE variables + to point to the directories where libdb.a and db.h are + installed. + + +#error db.h is for Berkeley DB 2.0-2.5 - need at least Berkeley DB 2.6.4 +------------------------------------------------------------------------ + +The error above will occur if there is a copy of the the file db.h for +Berkeley DB 2.0 to 2.5 on your system. + +This symptom can imply: + + 1. You don't have a new enough version of Berkeley DB. + Solution: get & install a newer version of Berkeley DB. + + 2. You have the correct version of Berkeley DB installed, but it isn't + in a standard place. + Solution: Edit config.in and set the LIB and INCLUDE variables + to point to the directories where libdb.a and db.h are + installed. + +Undefined Symbol: txn_stat +-------------------------- + +BerkeleyDB seems to have built correctly, but you get an error like this +when you run the test harness: + + $ make test + PERL_DL_NONLAZY=1 /home/paul/perl/install/bin/perl5.00503 + -Iblib/arch -Iblib/lib -I/usr/local/lib/perl5/5.00503/i586-linux + -I/usr/local/lib/perl5/5.00503 -e 'use Test::Harness qw(&runtests $verbose); + $verbose=0; runtests @ARGV;' t/*.t + t/btree.............Can't load 'blib/arch/auto/BerkeleyDB/BerkeleyDB.so' for + module BerkeleyDB: blib/arch/auto/BerkeleyDB/BerkeleyDB.so: + undefined symbol: txn_stat + at /usr/local/lib/perl5/5.00503/i586-linux/DynaLoader.pm line 169. + ... + +This error usually happens when you have both version 1 and a newer version +of Berkeley DB installed on your system. BerkeleyDB attempts +to build using the db.h for Berkeley DB version 2/3/4 and the version 1 +library. Unfortunately the two versions aren't compatible with each +other. BerkeleyDB can only be built with Berkeley DB version 2, 3 or 4. + +Solution: Setting the LIB & INCLUDE variables in config.in to point to the + correct directories can sometimes be enough to fix this + problem. If that doesn't work the easiest way to fix the + problem is to either delete or temporarily rename the copies + of db.h and libdb.a that you don't want BerkeleyDB to use. + +Undefined Symbol: db_appinit +---------------------------- + +BerkeleyDB seems to have built correctly, but you get an error like this +when you run the test harness: + + $ make test + PERL_DL_NONLAZY=1 /home/paul/perl/install/bin/perl5.00561 -Iblib/arch + -Iblib/lib -I/home/paul/perl/install/5.005_61/lib/5.00561/i586-linux + -I/home/paul/perl/install/5.005_61/lib/5.00561 -e 'use Test::Harness + qw(&runtests $verbose); $verbose=0; runtests @ARGV;' t/*.t + t/btree.............Can't load 'blib/arch/auto/BerkeleyDB/BerkeleyDB.so' for + module BerkeleyDB: blib/arch/auto/BerkeleyDB/BerkeleyDB.so: + undefined symbol: db_appinit + at /home/paul/perl/install/5.005_61/lib/5.00561/i586-linux/DynaLoader.pm + ... + + +This error usually happens when you have both version 2 and version +3 of Berkeley DB installed on your system and BerkeleyDB attempts +to build using the db.h for Berkeley DB version 2 and the version 3 +library. Unfortunately the two versions aren't compatible with each +other. + +Solution: Setting the LIB & INCLUDE variables in config.in to point to the + correct directories can sometimes be enough to fix this + problem. If that doesn't work the easiest way to fix the + problem is to either delete or temporarily rename the copies + of db.h and libdb.a that you don't want BerkeleyDB to use. + +Undefined Symbol: db_create +--------------------------- + +BerkeleyDB seems to have built correctly, but you get an error like this +when you run the test harness: + + $ make test + PERL_DL_NONLAZY=1 /home/paul/perl/install/bin/perl5.00561 -Iblib/arch + -Iblib/lib -I/home/paul/perl/install/5.005_61/lib/5.00561/i586-linux + -I/home/paul/perl/install/5.005_61/lib/5.00561 -e 'use Test::Harness + qw(&runtests $verbose); $verbose=0; runtests @ARGV;' t/*.t + t/btree.............Can't load 'blib/arch/auto/BerkeleyDB/BerkeleyDB.so' for + module BerkeleyDB: blib/arch/auto/BerkeleyDB/BerkeleyDB.so: + undefined symbol: db_create + at /home/paul/perl/install/5.005_61/lib/5.00561/i586-linux/DynaLoader.pm + ... + +This error usually happens when you have both version 2 and version +3 of Berkeley DB installed on your system and BerkeleyDB attempts +to build using the db.h for Berkeley DB version 3 and the version 2 +library. Unfortunately the two versions aren't compatible with each +other. + +Solution: Setting the LIB & INCLUDE variables in config.in to point to the + correct directories can sometimes be enough to fix this + problem. If that doesn't work the easiest way to fix the + problem is to either delete or temporarily rename the copies + of db.h and libdb.a that you don't want BerkeleyDB to use. + + +Incompatible versions of db.h and libdb +--------------------------------------- + +BerkeleyDB seems to have built correctly, but you get an error like this +when you run the test harness: + + $ make test + PERL_DL_NONLAZY=1 /home/paul/perl/install/bin/perl5.00503 + -Iblib/arch -Iblib/lib -I/usr/local/lib/perl5/5.00503/i586-linux + -I/usr/local/lib/perl5/5.00503 -e 'use Test::Harness qw(&runtests $verbose); + $verbose=0; runtests @ARGV;' t/*.t + t/btree............. + BerkeleyDB needs compatible versions of libdb & db.h + you have db.h version 2.6.4 and libdb version 2.7.5 + BEGIN failed--compilation aborted at t/btree.t line 25. + dubious + Test returned status 255 (wstat 65280, 0xff00) + ... + +Another variation on the theme of having two versions of Berkeley DB on +your system. + +Solution: Setting the LIB & INCLUDE variables in config.in to point to the + correct directories can sometimes be enough to fix this + problem. If that doesn't work the easiest way to fix the + problem is to either delete or temporarily rename the copies + of db.h and libdb.a that you don't want BerkeleyDB to use. + If you are running Linux, please read the Linux Notes section below. + + +Linux Notes +----------- + +Newer versions of Linux (e.g. RedHat 6, SuSe 6) ship with a C library +that has version 2.x of Berkeley DB linked into it. This makes it +difficult to build this module with anything other than the version of +Berkeley DB that shipped with your Linux release. If you do try to use +a different version of Berkeley DB you will most likely get the error +described in the "Incompatible versions of db.h and libdb" section of +this file. + +To make matters worse, prior to Perl 5.6.1, the perl binary itself +*always* included the Berkeley DB library. + +If you want to use a newer version of Berkeley DB with this module, the +easiest solution is to use Perl 5.6.1 (or better) and Berkeley DB 3.x +(or better). + +There are two approaches you can use to get older versions of Perl to +work with specific versions of Berkeley DB. Both have their advantages +and disadvantages. + +The first approach will only work when you want to build a version of +Perl older than 5.6.1 along with Berkeley DB 3.x. If you want to use +Berkeley DB 2.x, you must use the next approach. This approach involves +rebuilding your existing version of Perl after applying an unofficial +patch. The "patches" directory in the this module's source distribution +contains a number of patch files. There is one patch file for every +stable version of Perl since 5.004. Apply the appropriate patch to your +Perl source tree before re-building and installing Perl from scratch. +For example, assuming you are in the top-level source directory for +Perl 5.6.0, the command below will apply the necessary patch. Remember +to replace the path shown below with one that points to this module's +patches directory. + + patch -p1 -N </path/to/BerkeleyDB/patches/5.6.0 + +Now rebuild & install perl. You should now have a perl binary that can +be used to build this module. Follow the instructions in "BUILDING THE +MODULE", remembering to set the INCLUDE and LIB variables in config.in. + + +The second approach will work with Berkeley DB 2.x or better. +Start by building Berkeley DB as a shared library. This is from +the Berkeley DB build instructions: + + Building Shared Libraries for the GNU GCC compiler + + If you're using gcc and there's no better shared library example for + your architecture, the following shared library build procedure will + probably work. + + Add the -fpic option to the CFLAGS value in the Makefile. + + Rebuild all of your .o files. This will create a Berkeley DB library + that contains .o files with PIC code. To build the shared library, + then take the following steps in the library build directory: + + % mkdir tmp + % cd tmp + % ar xv ../libdb.a + % gcc -shared -o libdb.so *.o + % mv libdb.so .. + % cd .. + % rm -rf tmp + + Note, you may have to change the gcc line depending on the + requirements of your system. + + The file libdb.so is your shared library + +Once you have built libdb.so, you will need to store it somewhere safe. + + cp libdb.so /usr/local/BerkeleyDB/lib + +If you now set the LD_PRELOAD environment variable to point to this +shared library, Perl will use it instead of the version of Berkeley DB +that shipped with your Linux distribution. + + export LD_PRELOAD=/usr/local/BerkeleyDB/lib/libdb.so + +Finally follow the instructions in "BUILDING THE MODULE" to build, +test and install this module. Don't forget to set the INCLUDE and LIB +variables in config.in. + +Remember, you will need to have the LD_PRELOAD variable set anytime you +want to use Perl with Berkeley DB. Also note that if you have LD_PRELOAD +permanently set it will affect ALL commands you execute. This may be a +problem if you run any commands that access a database created by the +version of Berkeley DB that shipped with your Linux distribution. + + + +Solaris 2.5 Notes +----------------- + +If you are running Solaris 2.5, and you get this error when you run the +BerkeleyDB test harness: + + libc internal error: _rmutex_unlock: rmutex not held. + +you probably need to install a Sun patch. It has been reported that +Sun patch 103187-25 (or later revisions) fixes this problem. + +To find out if you have the patch installed, the command "showrev -p" +will display the patches that are currently installed on your system. + +Solaris 2.7 Notes +----------------- + +If you are running Solaris 2.7 and all the tests in the test harness +generate a core dump, try applying Sun patch 106980-09 (or better). + +To find out if you have the patch installed, the command "showrev -p" +will display the patches that are currently installed on your system. + + +HP-UX Notes +----------- + +Some people running HP-UX 10 have reported getting an error like this +when building this module with the native HP-UX compiler. + + ld: (Warning) At least one PA 2.0 object file (BerkeleyDB.o) was detected. + The linked output may not run on a PA 1.x system. + ld: Invalid loader fixup for symbol "$000000A5". + +If this is the case for you, Berkeley DB needs to be recompiled with +the +z or +Z option and the resulting library placed in a .sl file. The +following steps should do the trick: + + 1: Configure the Berkeley DB distribution with the +z or +Z C compiler + flag: + + env "CFLAGS=+z" ../dist/configure ... + + 2: Edit the Berkeley DB Makefile and change: + + "libdb= libdb.a" to "libdb= libdb.sl". + + 3: Build and install the Berkeley DB distribution as usual. + + + +FEEDBACK +-------- + +How to report a problem with BerkeleyDB. + +To help me help you, I need of the following information: + + 1. The version of Perl and the operating system name and version you + are running. The complete output from running "perl -V" will tell + me all I need to know. + If your perl does not understand the "-V" option is too old. + BerkeleyDB needs Perl version 5.004_04 or better. + + 2. The version of BerkeleyDB you have. If you have successfully + installed BerkeleyDB, this one-liner will tell you: + + perl -MBerkeleyDB -e 'print qq{BerkeleyDB ver $BerkeleyDB::VERSION\n}' + + If you haven't installed BerkeleyDB then search BerkeleyDB.pm for a + line like this: + + $VERSION = "1.20" ; + + 3. The version of Berkeley DB you have installed. If you have + successfully installed BerkeleyDB, this one-liner will tell you: + + perl -MBerkeleyDB -e 'print BerkeleyDB::DB_VERSION_STRING.qq{\n}' + + If you haven't installed BerkeleyDB then search db.h for a line + like this: + + #define DB_VERSION_STRING + + 4. If you are having problems building BerkeleyDB, send me a complete + log of what happened. + + 5. Now the difficult one. If you think you have found a bug in + BerkeleyDB and you want me to fix it, you will *greatly* enhance + the chances of me being able to track it down by sending me a small + self-contained Perl script that illustrates the problem you are + encountering. Include a summary of what you think the problem is + and a log of what happens when you run the script, in case I can't + reproduce your problem on my system. If possible, don't have the + script dependent on an existing 20Meg database. If the script you + send me can create the database itself then that is preferred. + + I realise that in some cases this is easier said than done, so if + you can only reproduce the problem in your existing script, then + you can post me that if you want. Just don't expect me to find your + problem in a hurry, or at all. :-) + + +CHANGES +------- + +See the Changes file. + +Paul Marquess <Paul.Marquess@btinternet.com> + diff --git a/storage/bdb/perl/BerkeleyDB/Todo b/storage/bdb/perl/BerkeleyDB/Todo new file mode 100644 index 00000000000..12d53bcf91c --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/Todo @@ -0,0 +1,57 @@ + + * Proper documentation. + + * address or document the "close all cursors if you encounter an error" + + * Change the $BerkeleyDB::Error to store the info in the db object, + if possible. + + * $BerkeleyDB::db_version is documented. &db_version isn't. + + * migrate perl code into the .xs file where necessary + + * convert as many of the DB examples files to BerkeleyDB format. + + * add a method to the DB object to allow access to the environment (if there + actually is one). + + +Possibles + + * use '~' magic to store the inner data. + + * for the get stuff zap the value to undef if it doesn't find the + key. This may be more intuitive for those folks who are used with + the $hash{key} interface. + + * Text interface? This can be done as via Recno + + * allow recno to allow base offset for arrays to be either 0 or 1. + + * when duplicate keys are enabled, allow db_put($key, [$val1, $val2,...]) + + +2.x -> 3.x Upgrade +================== + +Environment Verbose +Env->open mode +DB cache size extra parameter +DB->open subdatabases Done +An empty environment causes DB->open to fail +where is __db.001 coming from? db_remove seems to create it. Bug in 3.0.55 +Change db_strerror for 0 to ""? Done +Queue Done +db_stat for Hash & Queue Done +No TxnMgr +DB->remove +ENV->remove +ENV->set_verbose +upgrade + + $env = BerkeleyDB::Env::Create + $env = create BerkeleyDB::Env + $status = $env->open() + + $db = BerkeleyDB::Hash::Create + $status = $db->open() diff --git a/storage/bdb/perl/BerkeleyDB/config.in b/storage/bdb/perl/BerkeleyDB/config.in new file mode 100644 index 00000000000..fd1bb1caede --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/config.in @@ -0,0 +1,43 @@ +# Filename: config.in +# +# written by Paul Marquess <Paul.Marquess@btinternet.com> + +# 1. Where is the file db.h? +# +# Change the path below to point to the directory where db.h is +# installed on your system. + +INCLUDE = /usr/local/include +#INCLUDE = /usr/local/BerkeleyDB/include + +# 2. Where is libdb? +# +# Change the path below to point to the directory where libdb is +# installed on your system. + +LIB = /usr/local/lib +#LIB = /usr/local/BerkeleyDB/lib + +# 3. Is the library called libdb? +# +# If you have copies of both 1.x and 2.x Berkeley DB installed on +# your system it can sometimes be tricky to make sure you are using +# the correct one. Renaming one (or creating a symbolic link) to +# include the version number of the library can help. +# +# For example, if you have Berkeley DB 2.6.4 you could rename the +# Berkeley DB library from libdb.a to libdb-2.6.4.a and change the +# DBNAME line below to look like this: +# +# DBNAME = -ldb-2.6.4 +# +# Note: If you are building this module with Win32, -llibdb will be +# used by default. +# +# If you have changed the name of the library, uncomment the line +# below (by removing the leading #) and edit the line to use the name +# you have picked. + +#DBNAME = -ldb-3.0 + +# end of file config.in diff --git a/storage/bdb/perl/BerkeleyDB/constants.h b/storage/bdb/perl/BerkeleyDB/constants.h new file mode 100644 index 00000000000..d86cef15513 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/constants.h @@ -0,0 +1,4046 @@ +#define PERL_constant_NOTFOUND 1 +#define PERL_constant_NOTDEF 2 +#define PERL_constant_ISIV 3 +#define PERL_constant_ISNO 4 +#define PERL_constant_ISNV 5 +#define PERL_constant_ISPV 6 +#define PERL_constant_ISPVN 7 +#define PERL_constant_ISSV 8 +#define PERL_constant_ISUNDEF 9 +#define PERL_constant_ISUV 10 +#define PERL_constant_ISYES 11 + +#ifndef NVTYPE +typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it. */ +#endif +#ifndef aTHX_ +#define aTHX_ /* 5.6 or later define this for threading support. */ +#endif +#ifndef pTHX_ +#define pTHX_ /* 5.6 or later define this for threading support. */ +#endif + +static int +constant_6 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_DUP DB_PAD DB_RMW DB_SET */ + /* Offset 3 gives the best switch position. */ + switch (name[3]) { + case 'D': + if (memEQ(name, "DB_DUP", 6)) { + /* ^ */ +#ifdef DB_DUP + *iv_return = DB_DUP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_PAD", 6)) { + /* ^ */ +#ifdef DB_PAD + *iv_return = DB_PAD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_RMW", 6)) { + /* ^ */ +#ifdef DB_RMW + *iv_return = DB_RMW; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_SET", 6)) { + /* ^ */ +#ifdef DB_SET + *iv_return = DB_SET; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_7 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_EXCL DB_HASH DB_LAST DB_NEXT DB_PREV */ + /* Offset 3 gives the best switch position. */ + switch (name[3]) { + case 'E': + if (memEQ(name, "DB_EXCL", 7)) { + /* ^ */ +#ifdef DB_EXCL + *iv_return = DB_EXCL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "DB_HASH", 7)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_HASH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_LAST", 7)) { + /* ^ */ +#ifdef DB_LAST + *iv_return = DB_LAST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_NEXT", 7)) { + /* ^ */ +#ifdef DB_NEXT + *iv_return = DB_NEXT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_PREV", 7)) { + /* ^ */ +#ifdef DB_PREV + *iv_return = DB_PREV; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_8 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_AFTER DB_BTREE DB_FIRST DB_FLUSH DB_FORCE DB_QUEUE DB_RECNO */ + /* Offset 4 gives the best switch position. */ + switch (name[4]) { + case 'E': + if (memEQ(name, "DB_RECNO", 8)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_RECNO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "DB_AFTER", 8)) { + /* ^ */ +#ifdef DB_AFTER + *iv_return = DB_AFTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_FIRST", 8)) { + /* ^ */ +#ifdef DB_FIRST + *iv_return = DB_FIRST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_FLUSH", 8)) { + /* ^ */ +#ifdef DB_FLUSH + *iv_return = DB_FLUSH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_FORCE", 8)) { + /* ^ */ +#ifdef DB_FORCE + *iv_return = DB_FORCE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_BTREE", 8)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_BTREE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_QUEUE", 8)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 55) + *iv_return = DB_QUEUE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_9 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_APPEND DB_BEFORE DB_CLIENT DB_COMMIT DB_CREATE DB_CURLSN DB_DIRECT + DB_EXTENT DB_GETREC DB_NOCOPY DB_NOMMAP DB_NOSYNC DB_RDONLY DB_RECNUM + DB_THREAD DB_VERIFY */ + /* Offset 7 gives the best switch position. */ + switch (name[7]) { + case 'A': + if (memEQ(name, "DB_NOMMAP", 9)) { + /* ^ */ +#ifdef DB_NOMMAP + *iv_return = DB_NOMMAP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_THREAD", 9)) { + /* ^ */ +#ifdef DB_THREAD + *iv_return = DB_THREAD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_DIRECT", 9)) { + /* ^ */ +#ifdef DB_DIRECT + *iv_return = DB_DIRECT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_GETREC", 9)) { + /* ^ */ +#ifdef DB_GETREC + *iv_return = DB_GETREC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "DB_VERIFY", 9)) { + /* ^ */ +#ifdef DB_VERIFY + *iv_return = DB_VERIFY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_COMMIT", 9)) { + /* ^ */ +#ifdef DB_COMMIT + *iv_return = DB_COMMIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_RDONLY", 9)) { + /* ^ */ +#ifdef DB_RDONLY + *iv_return = DB_RDONLY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_APPEND", 9)) { + /* ^ */ +#ifdef DB_APPEND + *iv_return = DB_APPEND; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_CLIENT", 9)) { + /* ^ */ +#ifdef DB_CLIENT + *iv_return = DB_CLIENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_EXTENT", 9)) { + /* ^ */ +#ifdef DB_EXTENT + *iv_return = DB_EXTENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NOSYNC", 9)) { + /* ^ */ +#ifdef DB_NOSYNC + *iv_return = DB_NOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_NOCOPY", 9)) { + /* ^ */ +#ifdef DB_NOCOPY + *iv_return = DB_NOCOPY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_BEFORE", 9)) { + /* ^ */ +#ifdef DB_BEFORE + *iv_return = DB_BEFORE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_CURLSN", 9)) { + /* ^ */ +#ifdef DB_CURLSN + *iv_return = DB_CURLSN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_CREATE", 9)) { + /* ^ */ +#ifdef DB_CREATE + *iv_return = DB_CREATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_RECNUM", 9)) { + /* ^ */ +#ifdef DB_RECNUM + *iv_return = DB_RECNUM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_10 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_CONSUME DB_CURRENT DB_DELETED DB_DUPSORT DB_ENCRYPT DB_ENV_CDB + DB_ENV_TXN DB_JOINENV DB_KEYLAST DB_NOPANIC DB_OK_HASH DB_PRIVATE + DB_PR_PAGE DB_RECOVER DB_SALVAGE DB_TIMEOUT DB_TXN_CKP DB_UNKNOWN + DB_UPGRADE */ + /* Offset 8 gives the best switch position. */ + switch (name[8]) { + case 'D': + if (memEQ(name, "DB_ENV_CDB", 10)) { + /* ^ */ +#ifdef DB_ENV_CDB + *iv_return = DB_ENV_CDB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_UPGRADE", 10)) { + /* ^ */ +#ifdef DB_UPGRADE + *iv_return = DB_UPGRADE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_DELETED", 10)) { + /* ^ */ +#ifdef DB_DELETED + *iv_return = DB_DELETED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_RECOVER", 10)) { + /* ^ */ +#ifdef DB_RECOVER + *iv_return = DB_RECOVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_PR_PAGE", 10)) { + /* ^ */ +#ifdef DB_PR_PAGE + *iv_return = DB_PR_PAGE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SALVAGE", 10)) { + /* ^ */ +#ifdef DB_SALVAGE + *iv_return = DB_SALVAGE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_NOPANIC", 10)) { + /* ^ */ +#ifdef DB_NOPANIC + *iv_return = DB_NOPANIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'K': + if (memEQ(name, "DB_TXN_CKP", 10)) { + /* ^ */ +#ifdef DB_TXN_CKP + *iv_return = DB_TXN_CKP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_CONSUME", 10)) { + /* ^ */ +#ifdef DB_CONSUME + *iv_return = DB_CONSUME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_CURRENT", 10)) { + /* ^ */ +#ifdef DB_CURRENT + *iv_return = DB_CURRENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_JOINENV", 10)) { + /* ^ */ +#ifdef DB_JOINENV + *iv_return = DB_JOINENV; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_ENCRYPT", 10)) { + /* ^ */ +#ifdef DB_ENCRYPT + *iv_return = DB_ENCRYPT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_DUPSORT", 10)) { + /* ^ */ +#ifdef DB_DUPSORT + *iv_return = DB_DUPSORT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_KEYLAST", 10)) { + /* ^ */ +#ifdef DB_KEYLAST + *iv_return = DB_KEYLAST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OK_HASH", 10)) { + /* ^ */ +#ifdef DB_OK_HASH + *iv_return = DB_OK_HASH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_PRIVATE", 10)) { + /* ^ */ +#ifdef DB_PRIVATE + *iv_return = DB_PRIVATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_TIMEOUT", 10)) { + /* ^ */ +#ifdef DB_TIMEOUT + *iv_return = DB_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_UNKNOWN", 10)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_UNKNOWN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_ENV_TXN", 10)) { + /* ^ */ +#ifdef DB_ENV_TXN + *iv_return = DB_ENV_TXN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_11 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_APP_INIT DB_ARCH_ABS DB_ARCH_LOG DB_FIXEDLEN DB_GET_BOTH DB_INIT_CDB + DB_INIT_LOG DB_INIT_TXN DB_KEYEMPTY DB_KEYEXIST DB_KEYFIRST DB_LOCKDOWN + DB_LOCK_GET DB_LOCK_PUT DB_LOGMAGIC DB_LOG_DISK DB_MULTIPLE DB_NEXT_DUP + DB_NOSERVER DB_NOTFOUND DB_OK_BTREE DB_OK_QUEUE DB_OK_RECNO DB_POSITION + DB_QAMMAGIC DB_RENUMBER DB_SNAPSHOT DB_TRUNCATE DB_TXNMAGIC DB_TXN_LOCK + DB_TXN_REDO DB_TXN_SYNC DB_TXN_UNDO DB_WRNOSYNC DB_YIELDCPU */ + /* Offset 8 gives the best switch position. */ + switch (name[8]) { + case 'A': + if (memEQ(name, "DB_ARCH_ABS", 11)) { + /* ^ */ +#ifdef DB_ARCH_ABS + *iv_return = DB_ARCH_ABS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TRUNCATE", 11)) { + /* ^ */ +#ifdef DB_TRUNCATE + *iv_return = DB_TRUNCATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'B': + if (memEQ(name, "DB_RENUMBER", 11)) { + /* ^ */ +#ifdef DB_RENUMBER + *iv_return = DB_RENUMBER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_INIT_CDB", 11)) { + /* ^ */ +#ifdef DB_INIT_CDB + *iv_return = DB_INIT_CDB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OK_RECNO", 11)) { + /* ^ */ +#ifdef DB_OK_RECNO + *iv_return = DB_OK_RECNO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_YIELDCPU", 11)) { + /* ^ */ +#ifdef DB_YIELDCPU + *iv_return = DB_YIELDCPU; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'D': + if (memEQ(name, "DB_NEXT_DUP", 11)) { + /* ^ */ +#ifdef DB_NEXT_DUP + *iv_return = DB_NEXT_DUP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_OK_QUEUE", 11)) { + /* ^ */ +#ifdef DB_OK_QUEUE + *iv_return = DB_OK_QUEUE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_REDO", 11)) { + /* ^ */ +#ifdef DB_TXN_REDO + *iv_return = DB_TXN_REDO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_LOCK_GET", 11)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_LOCK_GET; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOGMAGIC", 11)) { + /* ^ */ +#ifdef DB_LOGMAGIC + *iv_return = DB_LOGMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_QAMMAGIC", 11)) { + /* ^ */ +#ifdef DB_QAMMAGIC + *iv_return = DB_QAMMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXNMAGIC", 11)) { + /* ^ */ +#ifdef DB_TXNMAGIC + *iv_return = DB_TXNMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "DB_SNAPSHOT", 11)) { + /* ^ */ +#ifdef DB_SNAPSHOT + *iv_return = DB_SNAPSHOT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_KEYEXIST", 11)) { + /* ^ */ +#ifdef DB_KEYEXIST + *iv_return = DB_KEYEXIST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOG_DISK", 11)) { + /* ^ */ +#ifdef DB_LOG_DISK + *iv_return = DB_LOG_DISK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_POSITION", 11)) { + /* ^ */ +#ifdef DB_POSITION + *iv_return = DB_POSITION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_ARCH_LOG", 11)) { + /* ^ */ +#ifdef DB_ARCH_LOG + *iv_return = DB_ARCH_LOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_FIXEDLEN", 11)) { + /* ^ */ +#ifdef DB_FIXEDLEN + *iv_return = DB_FIXEDLEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_INIT_LOG", 11)) { + /* ^ */ +#ifdef DB_INIT_LOG + *iv_return = DB_INIT_LOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_APP_INIT", 11)) { + /* ^ */ +#ifdef DB_APP_INIT + *iv_return = DB_APP_INIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_UNDO", 11)) { + /* ^ */ +#ifdef DB_TXN_UNDO + *iv_return = DB_TXN_UNDO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_GET_BOTH", 11)) { + /* ^ */ +#ifdef DB_GET_BOTH + *iv_return = DB_GET_BOTH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCKDOWN", 11)) { + /* ^ */ +#ifdef DB_LOCKDOWN + *iv_return = DB_LOCKDOWN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_LOCK", 11)) { + /* ^ */ +#ifdef DB_TXN_LOCK + *iv_return = DB_TXN_LOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_KEYEMPTY", 11)) { + /* ^ */ +#ifdef DB_KEYEMPTY + *iv_return = DB_KEYEMPTY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_PUT", 11)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_LOCK_PUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MULTIPLE", 11)) { + /* ^ */ +#ifdef DB_MULTIPLE + *iv_return = DB_MULTIPLE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_KEYFIRST", 11)) { + /* ^ */ +#ifdef DB_KEYFIRST + *iv_return = DB_KEYFIRST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OK_BTREE", 11)) { + /* ^ */ +#ifdef DB_OK_BTREE + *iv_return = DB_OK_BTREE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_INIT_TXN", 11)) { + /* ^ */ +#ifdef DB_INIT_TXN + *iv_return = DB_INIT_TXN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_NOTFOUND", 11)) { + /* ^ */ +#ifdef DB_NOTFOUND + *iv_return = DB_NOTFOUND; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_NOSERVER", 11)) { + /* ^ */ +#ifdef DB_NOSERVER + *iv_return = DB_NOSERVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "DB_TXN_SYNC", 11)) { + /* ^ */ +#ifdef DB_TXN_SYNC + *iv_return = DB_TXN_SYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_WRNOSYNC", 11)) { + /* ^ */ +#ifdef DB_WRNOSYNC + *iv_return = DB_WRNOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_12 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_ARCH_DATA DB_CDB_ALLDB DB_CL_WRITER DB_DELIMITER DB_DIRECT_DB + DB_DUPCURSOR DB_ENV_FATAL DB_FAST_STAT DB_GET_BOTHC DB_GET_RECNO + DB_HASHMAGIC DB_INIT_LOCK DB_JOIN_ITEM DB_LOCKMAGIC DB_LOCK_DUMP + DB_LOCK_RW_N DB_LOGOLDVER DB_MAX_PAGES DB_MPOOL_NEW DB_NEEDSPLIT + DB_NODUPDATA DB_NOLOCKING DB_NORECURSE DB_OVERWRITE DB_PAGEYIELD + DB_PAGE_LOCK DB_PERMANENT DB_POSITIONI DB_PRINTABLE DB_QAMOLDVER + DB_SET_RANGE DB_SET_RECNO DB_SWAPBYTES DB_TEMPORARY DB_TXN_ABORT + DB_TXN_APPLY DB_TXN_PRINT DB_WRITELOCK DB_WRITEOPEN DB_XA_CREATE */ + /* Offset 3 gives the best switch position. */ + switch (name[3]) { + case 'A': + if (memEQ(name, "DB_ARCH_DATA", 12)) { + /* ^ */ +#ifdef DB_ARCH_DATA + *iv_return = DB_ARCH_DATA; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_CDB_ALLDB", 12)) { + /* ^ */ +#ifdef DB_CDB_ALLDB + *iv_return = DB_CDB_ALLDB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_CL_WRITER", 12)) { + /* ^ */ +#ifdef DB_CL_WRITER + *iv_return = DB_CL_WRITER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'D': + if (memEQ(name, "DB_DELIMITER", 12)) { + /* ^ */ +#ifdef DB_DELIMITER + *iv_return = DB_DELIMITER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_DIRECT_DB", 12)) { + /* ^ */ +#ifdef DB_DIRECT_DB + *iv_return = DB_DIRECT_DB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_DUPCURSOR", 12)) { + /* ^ */ +#ifdef DB_DUPCURSOR + *iv_return = DB_DUPCURSOR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_ENV_FATAL", 12)) { + /* ^ */ +#ifdef DB_ENV_FATAL + *iv_return = DB_ENV_FATAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "DB_FAST_STAT", 12)) { + /* ^ */ +#ifdef DB_FAST_STAT + *iv_return = DB_FAST_STAT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_GET_BOTHC", 12)) { + /* ^ */ +#ifdef DB_GET_BOTHC + *iv_return = DB_GET_BOTHC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_GET_RECNO", 12)) { + /* ^ */ +#ifdef DB_GET_RECNO + *iv_return = DB_GET_RECNO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "DB_HASHMAGIC", 12)) { + /* ^ */ +#ifdef DB_HASHMAGIC + *iv_return = DB_HASHMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_INIT_LOCK", 12)) { + /* ^ */ +#ifdef DB_INIT_LOCK + *iv_return = DB_INIT_LOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'J': + if (memEQ(name, "DB_JOIN_ITEM", 12)) { + /* ^ */ +#ifdef DB_JOIN_ITEM + *iv_return = DB_JOIN_ITEM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_LOCKMAGIC", 12)) { + /* ^ */ +#ifdef DB_LOCKMAGIC + *iv_return = DB_LOCKMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_DUMP", 12)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_LOCK_DUMP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_RW_N", 12)) { + /* ^ */ +#ifdef DB_LOCK_RW_N + *iv_return = DB_LOCK_RW_N; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOGOLDVER", 12)) { + /* ^ */ +#ifdef DB_LOGOLDVER + *iv_return = DB_LOGOLDVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_MAX_PAGES", 12)) { + /* ^ */ +#ifdef DB_MAX_PAGES + *iv_return = DB_MAX_PAGES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MPOOL_NEW", 12)) { + /* ^ */ +#ifdef DB_MPOOL_NEW + *iv_return = DB_MPOOL_NEW; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_NEEDSPLIT", 12)) { + /* ^ */ +#ifdef DB_NEEDSPLIT + *iv_return = DB_NEEDSPLIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NODUPDATA", 12)) { + /* ^ */ +#ifdef DB_NODUPDATA + *iv_return = DB_NODUPDATA; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NOLOCKING", 12)) { + /* ^ */ +#ifdef DB_NOLOCKING + *iv_return = DB_NOLOCKING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NORECURSE", 12)) { + /* ^ */ +#ifdef DB_NORECURSE + *iv_return = DB_NORECURSE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_OVERWRITE", 12)) { + /* ^ */ +#ifdef DB_OVERWRITE + *iv_return = DB_OVERWRITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_PAGEYIELD", 12)) { + /* ^ */ +#ifdef DB_PAGEYIELD + *iv_return = DB_PAGEYIELD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PAGE_LOCK", 12)) { + /* ^ */ +#ifdef DB_PAGE_LOCK + *iv_return = DB_PAGE_LOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PERMANENT", 12)) { + /* ^ */ +#ifdef DB_PERMANENT + *iv_return = DB_PERMANENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_POSITIONI", 12)) { + /* ^ */ +#ifdef DB_POSITIONI + *iv_return = DB_POSITIONI; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PRINTABLE", 12)) { + /* ^ */ +#ifdef DB_PRINTABLE + *iv_return = DB_PRINTABLE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Q': + if (memEQ(name, "DB_QAMOLDVER", 12)) { + /* ^ */ +#ifdef DB_QAMOLDVER + *iv_return = DB_QAMOLDVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_SET_RANGE", 12)) { + /* ^ */ +#ifdef DB_SET_RANGE + *iv_return = DB_SET_RANGE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SET_RECNO", 12)) { + /* ^ */ +#ifdef DB_SET_RECNO + *iv_return = DB_SET_RECNO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SWAPBYTES", 12)) { + /* ^ */ +#ifdef DB_SWAPBYTES + *iv_return = DB_SWAPBYTES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_TEMPORARY", 12)) { + /* ^ */ +#ifdef DB_TEMPORARY + *iv_return = DB_TEMPORARY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_ABORT", 12)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 12) + *iv_return = DB_TXN_ABORT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_APPLY", 12)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 7) + *iv_return = DB_TXN_APPLY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_PRINT", 12)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_TXN_PRINT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_WRITELOCK", 12)) { + /* ^ */ +#ifdef DB_WRITELOCK + *iv_return = DB_WRITELOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_WRITEOPEN", 12)) { + /* ^ */ +#ifdef DB_WRITEOPEN + *iv_return = DB_WRITEOPEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_XA_CREATE", 12)) { + /* ^ */ +#ifdef DB_XA_CREATE + *iv_return = DB_XA_CREATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_13 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_AGGRESSIVE DB_BTREEMAGIC DB_CHECKPOINT DB_DIRECT_LOG DB_DIRTY_READ + DB_DONOTINDEX DB_ENV_CREATE DB_ENV_NOMMAP DB_ENV_THREAD DB_HASHOLDVER + DB_INCOMPLETE DB_INIT_MPOOL DB_LOCK_NORUN DB_LOCK_RIW_N DB_LOCK_TRADE + DB_LOGVERSION DB_LOG_LOCKED DB_MPOOL_LAST DB_MUTEXDEBUG DB_MUTEXLOCKS + DB_NEXT_NODUP DB_NOORDERCHK DB_PREV_NODUP DB_PR_HEADERS DB_QAMVERSION + DB_RDWRMASTER DB_REGISTERED DB_REP_CLIENT DB_REP_MASTER DB_SEQUENTIAL + DB_STAT_CLEAR DB_SYSTEM_MEM DB_TXNVERSION DB_TXN_NOSYNC DB_TXN_NOWAIT + DB_VERIFY_BAD */ + /* Offset 5 gives the best switch position. */ + switch (name[5]) { + case 'A': + if (memEQ(name, "DB_STAT_CLEAR", 13)) { + /* ^ */ +#ifdef DB_STAT_CLEAR + *iv_return = DB_STAT_CLEAR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_INCOMPLETE", 13)) { + /* ^ */ +#ifdef DB_INCOMPLETE + *iv_return = DB_INCOMPLETE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_NORUN", 13)) { + /* ^ */ +#ifdef DB_LOCK_NORUN + *iv_return = DB_LOCK_NORUN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_RIW_N", 13)) { + /* ^ */ +#ifdef DB_LOCK_RIW_N + *iv_return = DB_LOCK_RIW_N; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_TRADE", 13)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_LOCK_TRADE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_CHECKPOINT", 13)) { + /* ^ */ +#ifdef DB_CHECKPOINT + *iv_return = DB_CHECKPOINT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PREV_NODUP", 13)) { + /* ^ */ +#ifdef DB_PREV_NODUP + *iv_return = DB_PREV_NODUP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_AGGRESSIVE", 13)) { + /* ^ */ +#ifdef DB_AGGRESSIVE + *iv_return = DB_AGGRESSIVE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOGVERSION", 13)) { + /* ^ */ +#ifdef DB_LOGVERSION + *iv_return = DB_LOGVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOG_LOCKED", 13)) { + /* ^ */ +#ifdef DB_LOG_LOCKED + *iv_return = DB_LOG_LOCKED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REGISTERED", 13)) { + /* ^ */ +#ifdef DB_REGISTERED + *iv_return = DB_REGISTERED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_INIT_MPOOL", 13)) { + /* ^ */ +#ifdef DB_INIT_MPOOL + *iv_return = DB_INIT_MPOOL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_QAMVERSION", 13)) { + /* ^ */ +#ifdef DB_QAMVERSION + *iv_return = DB_QAMVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_DONOTINDEX", 13)) { + /* ^ */ +#ifdef DB_DONOTINDEX + *iv_return = DB_DONOTINDEX; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXNVERSION", 13)) { + /* ^ */ +#ifdef DB_TXNVERSION + *iv_return = DB_TXNVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_NOSYNC", 13)) { + /* ^ */ +#ifdef DB_TXN_NOSYNC + *iv_return = DB_TXN_NOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_NOWAIT", 13)) { + /* ^ */ +#ifdef DB_TXN_NOWAIT + *iv_return = DB_TXN_NOWAIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_MPOOL_LAST", 13)) { + /* ^ */ +#ifdef DB_MPOOL_LAST + *iv_return = DB_MPOOL_LAST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NOORDERCHK", 13)) { + /* ^ */ +#ifdef DB_NOORDERCHK + *iv_return = DB_NOORDERCHK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_REP_CLIENT", 13)) { + /* ^ */ +#ifdef DB_REP_CLIENT + *iv_return = DB_REP_CLIENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REP_MASTER", 13)) { + /* ^ */ +#ifdef DB_REP_MASTER + *iv_return = DB_REP_MASTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Q': + if (memEQ(name, "DB_SEQUENTIAL", 13)) { + /* ^ */ +#ifdef DB_SEQUENTIAL + *iv_return = DB_SEQUENTIAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_BTREEMAGIC", 13)) { + /* ^ */ +#ifdef DB_BTREEMAGIC + *iv_return = DB_BTREEMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_DIRECT_LOG", 13)) { + /* ^ */ +#ifdef DB_DIRECT_LOG + *iv_return = DB_DIRECT_LOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_DIRTY_READ", 13)) { + /* ^ */ +#ifdef DB_DIRTY_READ + *iv_return = DB_DIRTY_READ; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERIFY_BAD", 13)) { + /* ^ */ +#ifdef DB_VERIFY_BAD + *iv_return = DB_VERIFY_BAD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_HASHOLDVER", 13)) { + /* ^ */ +#ifdef DB_HASHOLDVER + *iv_return = DB_HASHOLDVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SYSTEM_MEM", 13)) { + /* ^ */ +#ifdef DB_SYSTEM_MEM + *iv_return = DB_SYSTEM_MEM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_MUTEXDEBUG", 13)) { + /* ^ */ +#ifdef DB_MUTEXDEBUG + *iv_return = DB_MUTEXDEBUG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MUTEXLOCKS", 13)) { + /* ^ */ +#ifdef DB_MUTEXLOCKS + *iv_return = DB_MUTEXLOCKS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_ENV_CREATE", 13)) { + /* ^ */ +#ifdef DB_ENV_CREATE + *iv_return = DB_ENV_CREATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_NOMMAP", 13)) { + /* ^ */ +#ifdef DB_ENV_NOMMAP + *iv_return = DB_ENV_NOMMAP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_THREAD", 13)) { + /* ^ */ +#ifdef DB_ENV_THREAD + *iv_return = DB_ENV_THREAD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_RDWRMASTER", 13)) { + /* ^ */ +#ifdef DB_RDWRMASTER + *iv_return = DB_RDWRMASTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_NEXT_NODUP", 13)) { + /* ^ */ +#ifdef DB_NEXT_NODUP + *iv_return = DB_NEXT_NODUP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_PR_HEADERS", 13)) { + /* ^ */ +#ifdef DB_PR_HEADERS + *iv_return = DB_PR_HEADERS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_14 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_AUTO_COMMIT DB_BTREEOLDVER DB_CHKSUM_SHA1 DB_EID_INVALID DB_ENCRYPT_AES + DB_ENV_APPINIT DB_ENV_DBLOCAL DB_ENV_LOCKING DB_ENV_LOGGING DB_ENV_NOPANIC + DB_ENV_PRIVATE DB_FILE_ID_LEN DB_HANDLE_LOCK DB_HASHVERSION DB_INVALID_EID + DB_JOIN_NOSORT DB_LOCKVERSION DB_LOCK_EXPIRE DB_LOCK_NOWAIT DB_LOCK_OLDEST + DB_LOCK_RANDOM DB_LOCK_RECORD DB_LOCK_REMOVE DB_LOCK_SWITCH DB_MAX_RECORDS + DB_MPOOL_CLEAN DB_MPOOL_DIRTY DB_NOOVERWRITE DB_NOSERVER_ID DB_ODDFILESIZE + DB_OLD_VERSION DB_OPEN_CALLED DB_RECORDCOUNT DB_RECORD_LOCK DB_REGION_ANON + DB_REGION_INIT DB_REGION_NAME DB_RENAMEMAGIC DB_REP_NEWSITE DB_REP_UNAVAIL + DB_REVSPLITOFF DB_RUNRECOVERY DB_SET_TXN_NOW DB_USE_ENVIRON DB_WRITECURSOR + DB_XIDDATASIZE */ + /* Offset 9 gives the best switch position. */ + switch (name[9]) { + case 'A': + if (memEQ(name, "DB_LOCK_RANDOM", 14)) { + /* ^ */ +#ifdef DB_LOCK_RANDOM + *iv_return = DB_LOCK_RANDOM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OPEN_CALLED", 14)) { + /* ^ */ +#ifdef DB_OPEN_CALLED + *iv_return = DB_OPEN_CALLED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REP_UNAVAIL", 14)) { + /* ^ */ +#ifdef DB_REP_UNAVAIL + *iv_return = DB_REP_UNAVAIL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_XIDDATASIZE", 14)) { + /* ^ */ +#ifdef DB_XIDDATASIZE + *iv_return = DB_XIDDATASIZE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_ENV_LOCKING", 14)) { + /* ^ */ +#ifdef DB_ENV_LOCKING + *iv_return = DB_ENV_LOCKING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MAX_RECORDS", 14)) { + /* ^ */ +#ifdef DB_MAX_RECORDS + *iv_return = DB_MAX_RECORDS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MPOOL_CLEAN", 14)) { + /* ^ */ +#ifdef DB_MPOOL_CLEAN + *iv_return = DB_MPOOL_CLEAN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_RECORDCOUNT", 14)) { + /* ^ */ +#ifdef DB_RECORDCOUNT + *iv_return = DB_RECORDCOUNT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'D': + if (memEQ(name, "DB_FILE_ID_LEN", 14)) { + /* ^ */ +#ifdef DB_FILE_ID_LEN + *iv_return = DB_FILE_ID_LEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_INVALID_EID", 14)) { + /* ^ */ +#ifdef DB_INVALID_EID + *iv_return = DB_INVALID_EID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MPOOL_DIRTY", 14)) { + /* ^ */ +#ifdef DB_MPOOL_DIRTY + *iv_return = DB_MPOOL_DIRTY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_LOCK_RECORD", 14)) { + /* ^ */ +#ifdef DB_LOCK_RECORD + *iv_return = DB_LOCK_RECORD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_REMOVE", 14)) { + /* ^ */ +#ifdef DB_LOCK_REMOVE + *iv_return = DB_LOCK_REMOVE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NOSERVER_ID", 14)) { + /* ^ */ +#ifdef DB_NOSERVER_ID + *iv_return = DB_NOSERVER_ID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ODDFILESIZE", 14)) { + /* ^ */ +#ifdef DB_ODDFILESIZE + *iv_return = DB_ODDFILESIZE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_ENV_LOGGING", 14)) { + /* ^ */ +#ifdef DB_ENV_LOGGING + *iv_return = DB_ENV_LOGGING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_ENV_PRIVATE", 14)) { + /* ^ */ +#ifdef DB_ENV_PRIVATE + *iv_return = DB_ENV_PRIVATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REVSPLITOFF", 14)) { + /* ^ */ +#ifdef DB_REVSPLITOFF + *iv_return = DB_REVSPLITOFF; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_BTREEOLDVER", 14)) { + /* ^ */ +#ifdef DB_BTREEOLDVER + *iv_return = DB_BTREEOLDVER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_DBLOCAL", 14)) { + /* ^ */ +#ifdef DB_ENV_DBLOCAL + *iv_return = DB_ENV_DBLOCAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_OLDEST", 14)) { + /* ^ */ +#ifdef DB_LOCK_OLDEST + *iv_return = DB_LOCK_OLDEST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_RENAMEMAGIC", 14)) { + /* ^ */ +#ifdef DB_RENAMEMAGIC + *iv_return = DB_RENAMEMAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_SET_TXN_NOW", 14)) { + /* ^ */ +#ifdef DB_SET_TXN_NOW + *iv_return = DB_SET_TXN_NOW; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_AUTO_COMMIT", 14)) { + /* ^ */ +#ifdef DB_AUTO_COMMIT + *iv_return = DB_AUTO_COMMIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_JOIN_NOSORT", 14)) { + /* ^ */ +#ifdef DB_JOIN_NOSORT + *iv_return = DB_JOIN_NOSORT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_NOWAIT", 14)) { + /* ^ */ +#ifdef DB_LOCK_NOWAIT + *iv_return = DB_LOCK_NOWAIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_RUNRECOVERY", 14)) { + /* ^ */ +#ifdef DB_RUNRECOVERY + *iv_return = DB_RUNRECOVERY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_ENV_APPINIT", 14)) { + /* ^ */ +#ifdef DB_ENV_APPINIT + *iv_return = DB_ENV_APPINIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_NOPANIC", 14)) { + /* ^ */ +#ifdef DB_ENV_NOPANIC + *iv_return = DB_ENV_NOPANIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_HASHVERSION", 14)) { + /* ^ */ +#ifdef DB_HASHVERSION + *iv_return = DB_HASHVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCKVERSION", 14)) { + /* ^ */ +#ifdef DB_LOCKVERSION + *iv_return = DB_LOCKVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OLD_VERSION", 14)) { + /* ^ */ +#ifdef DB_OLD_VERSION + *iv_return = DB_OLD_VERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_ENCRYPT_AES", 14)) { + /* ^ */ +#ifdef DB_ENCRYPT_AES + *iv_return = DB_ENCRYPT_AES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_WRITECURSOR", 14)) { + /* ^ */ +#ifdef DB_WRITECURSOR + *iv_return = DB_WRITECURSOR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_EID_INVALID", 14)) { + /* ^ */ +#ifdef DB_EID_INVALID + *iv_return = DB_EID_INVALID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_USE_ENVIRON", 14)) { + /* ^ */ +#ifdef DB_USE_ENVIRON + *iv_return = DB_USE_ENVIRON; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_LOCK_SWITCH", 14)) { + /* ^ */ +#ifdef DB_LOCK_SWITCH + *iv_return = DB_LOCK_SWITCH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_NOOVERWRITE", 14)) { + /* ^ */ +#ifdef DB_NOOVERWRITE + *iv_return = DB_NOOVERWRITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REP_NEWSITE", 14)) { + /* ^ */ +#ifdef DB_REP_NEWSITE + *iv_return = DB_REP_NEWSITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_LOCK_EXPIRE", 14)) { + /* ^ */ +#ifdef DB_LOCK_EXPIRE + *iv_return = DB_LOCK_EXPIRE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_CHKSUM_SHA1", 14)) { + /* ^ */ +#ifdef DB_CHKSUM_SHA1 + *iv_return = DB_CHKSUM_SHA1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_HANDLE_LOCK", 14)) { + /* ^ */ +#ifdef DB_HANDLE_LOCK + *iv_return = DB_HANDLE_LOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_RECORD_LOCK", 14)) { + /* ^ */ +#ifdef DB_RECORD_LOCK + *iv_return = DB_RECORD_LOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REGION_ANON", 14)) { + /* ^ */ +#ifdef DB_REGION_ANON + *iv_return = DB_REGION_ANON; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REGION_INIT", 14)) { + /* ^ */ +#ifdef DB_REGION_INIT + *iv_return = DB_REGION_INIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REGION_NAME", 14)) { + /* ^ */ +#ifdef DB_REGION_NAME + *iv_return = DB_REGION_NAME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_15 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_APPLY_LOGREG DB_BTREEVERSION DB_CONSUME_WAIT DB_ENV_LOCKDOWN + DB_ENV_PANIC_OK DB_ENV_YIELDCPU DB_LOCK_DEFAULT DB_LOCK_INHERIT + DB_LOCK_NOTHELD DB_LOCK_PUT_ALL DB_LOCK_PUT_OBJ DB_LOCK_TIMEOUT + DB_LOCK_UPGRADE DB_MPOOL_CREATE DB_MPOOL_EXTENT DB_MULTIPLE_KEY + DB_OPFLAGS_MASK DB_ORDERCHKONLY DB_PRIORITY_LOW DB_REGION_MAGIC + DB_REP_LOGSONLY DB_REP_OUTDATED DB_SURPRISE_KID DB_TEST_POSTLOG + DB_TEST_PREOPEN DB_TXN_GETPGNOS DB_TXN_LOCK_2PL DB_TXN_LOG_MASK + DB_TXN_LOG_REDO DB_TXN_LOG_UNDO DB_VERIFY_FATAL */ + /* Offset 10 gives the best switch position. */ + switch (name[10]) { + case 'D': + if (memEQ(name, "DB_REP_OUTDATED", 15)) { + /* ^ */ +#ifdef DB_REP_OUTDATED + *iv_return = DB_REP_OUTDATED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_MULTIPLE_KEY", 15)) { + /* ^ */ +#ifdef DB_MULTIPLE_KEY + *iv_return = DB_MULTIPLE_KEY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SURPRISE_KID", 15)) { + /* ^ */ +#ifdef DB_SURPRISE_KID + *iv_return = DB_SURPRISE_KID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_PREOPEN", 15)) { + /* ^ */ +#ifdef DB_TEST_PREOPEN + *iv_return = DB_TEST_PREOPEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'F': + if (memEQ(name, "DB_LOCK_DEFAULT", 15)) { + /* ^ */ +#ifdef DB_LOCK_DEFAULT + *iv_return = DB_LOCK_DEFAULT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERIFY_FATAL", 15)) { + /* ^ */ +#ifdef DB_VERIFY_FATAL + *iv_return = DB_VERIFY_FATAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_LOCK_UPGRADE", 15)) { + /* ^ */ +#ifdef DB_LOCK_UPGRADE + *iv_return = DB_LOCK_UPGRADE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "DB_LOCK_INHERIT", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 7) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 7 && \ + DB_VERSION_PATCH >= 1) + *iv_return = DB_LOCK_INHERIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_ENV_PANIC_OK", 15)) { + /* ^ */ +#ifdef DB_ENV_PANIC_OK + *iv_return = DB_ENV_PANIC_OK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'K': + if (memEQ(name, "DB_ENV_LOCKDOWN", 15)) { + /* ^ */ +#ifdef DB_ENV_LOCKDOWN + *iv_return = DB_ENV_LOCKDOWN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ORDERCHKONLY", 15)) { + /* ^ */ +#ifdef DB_ORDERCHKONLY + *iv_return = DB_ORDERCHKONLY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_LOCK_2PL", 15)) { + /* ^ */ +#ifdef DB_TXN_LOCK_2PL + *iv_return = DB_TXN_LOCK_2PL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_ENV_YIELDCPU", 15)) { + /* ^ */ +#ifdef DB_ENV_YIELDCPU + *iv_return = DB_ENV_YIELDCPU; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_LOCK_TIMEOUT", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 7) + *iv_return = DB_LOCK_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REGION_MAGIC", 15)) { + /* ^ */ +#ifdef DB_REGION_MAGIC + *iv_return = DB_REGION_MAGIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_APPLY_LOGREG", 15)) { + /* ^ */ +#ifdef DB_APPLY_LOGREG + *iv_return = DB_APPLY_LOGREG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_TXN_GETPGNOS", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_TXN_GETPGNOS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_BTREEVERSION", 15)) { + /* ^ */ +#ifdef DB_BTREEVERSION + *iv_return = DB_BTREEVERSION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MPOOL_CREATE", 15)) { + /* ^ */ +#ifdef DB_MPOOL_CREATE + *iv_return = DB_MPOOL_CREATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_REP_LOGSONLY", 15)) { + /* ^ */ +#ifdef DB_REP_LOGSONLY + *iv_return = DB_REP_LOGSONLY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_POSTLOG", 15)) { + /* ^ */ +#ifdef DB_TEST_POSTLOG + *iv_return = DB_TEST_POSTLOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_LOCK_NOTHELD", 15)) { + /* ^ */ +#ifdef DB_LOCK_NOTHELD + *iv_return = DB_LOCK_NOTHELD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_PUT_ALL", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_LOCK_PUT_ALL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_PUT_OBJ", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 2) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 0) + *iv_return = DB_LOCK_PUT_OBJ; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_MPOOL_EXTENT", 15)) { + /* ^ */ +#ifdef DB_MPOOL_EXTENT + *iv_return = DB_MPOOL_EXTENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "DB_PRIORITY_LOW", 15)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_PRIORITY_LOW; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_CONSUME_WAIT", 15)) { + /* ^ */ +#ifdef DB_CONSUME_WAIT + *iv_return = DB_CONSUME_WAIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_OPFLAGS_MASK", 15)) { + /* ^ */ +#ifdef DB_OPFLAGS_MASK + *iv_return = DB_OPFLAGS_MASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_LOG_MASK", 15)) { + /* ^ */ +#ifdef DB_TXN_LOG_MASK + *iv_return = DB_TXN_LOG_MASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_LOG_REDO", 15)) { + /* ^ */ +#ifdef DB_TXN_LOG_REDO + *iv_return = DB_TXN_LOG_REDO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_LOG_UNDO", 15)) { + /* ^ */ +#ifdef DB_TXN_LOG_UNDO + *iv_return = DB_TXN_LOG_UNDO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_16 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_BROADCAST_EID DB_CACHED_COUNTS DB_EID_BROADCAST DB_ENV_CDB_ALLDB + DB_ENV_DIRECT_DB DB_ENV_NOLOCKING DB_ENV_OVERWRITE DB_ENV_RPCCLIENT + DB_FCNTL_LOCKING DB_JAVA_CALLBACK DB_LOCK_CONFLICT DB_LOCK_DEADLOCK + DB_LOCK_MAXLOCKS DB_LOCK_MINLOCKS DB_LOCK_MINWRITE DB_LOCK_NOTEXIST + DB_LOCK_PUT_READ DB_LOCK_YOUNGEST DB_LOGC_BUF_SIZE DB_MPOOL_DISCARD + DB_MPOOL_PRIVATE DB_NOSERVER_HOME DB_PAGE_NOTFOUND DB_PRIORITY_HIGH + DB_RECOVER_FATAL DB_REP_DUPMASTER DB_REP_NEWMASTER DB_REP_PERMANENT + DB_SECONDARY_BAD DB_TEST_POSTOPEN DB_TEST_POSTSYNC DB_TXN_LOCK_MASK + DB_TXN_OPENFILES DB_VERB_CHKPOINT DB_VERB_DEADLOCK DB_VERB_RECOVERY + DB_VERB_WAITSFOR DB_VERSION_MAJOR DB_VERSION_MINOR DB_VERSION_PATCH + DB_VRFY_FLAGMASK */ + /* Offset 12 gives the best switch position. */ + switch (name[12]) { + case 'A': + if (memEQ(name, "DB_RECOVER_FATAL", 16)) { + /* ^ */ +#ifdef DB_RECOVER_FATAL + *iv_return = DB_RECOVER_FATAL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERSION_MAJOR", 16)) { + /* ^ */ +#ifdef DB_VERSION_MAJOR + *iv_return = DB_VERSION_MAJOR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERSION_PATCH", 16)) { + /* ^ */ +#ifdef DB_VERSION_PATCH + *iv_return = DB_VERSION_PATCH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'B': + if (memEQ(name, "DB_JAVA_CALLBACK", 16)) { + /* ^ */ +#ifdef DB_JAVA_CALLBACK + *iv_return = DB_JAVA_CALLBACK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'C': + if (memEQ(name, "DB_EID_BROADCAST", 16)) { + /* ^ */ +#ifdef DB_EID_BROADCAST + *iv_return = DB_EID_BROADCAST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_MPOOL_DISCARD", 16)) { + /* ^ */ +#ifdef DB_MPOOL_DISCARD + *iv_return = DB_MPOOL_DISCARD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_LOCK_YOUNGEST", 16)) { + /* ^ */ +#ifdef DB_LOCK_YOUNGEST + *iv_return = DB_LOCK_YOUNGEST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'H': + if (memEQ(name, "DB_NOSERVER_HOME", 16)) { + /* ^ */ +#ifdef DB_NOSERVER_HOME + *iv_return = DB_NOSERVER_HOME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PRIORITY_HIGH", 16)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_PRIORITY_HIGH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_ENV_RPCCLIENT", 16)) { + /* ^ */ +#ifdef DB_ENV_RPCCLIENT + *iv_return = DB_ENV_RPCCLIENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_OPENFILES", 16)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 12) + *iv_return = DB_TXN_OPENFILES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERSION_MINOR", 16)) { + /* ^ */ +#ifdef DB_VERSION_MINOR + *iv_return = DB_VERSION_MINOR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'K': + if (memEQ(name, "DB_ENV_NOLOCKING", 16)) { + /* ^ */ +#ifdef DB_ENV_NOLOCKING + *iv_return = DB_ENV_NOLOCKING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_FCNTL_LOCKING", 16)) { + /* ^ */ +#ifdef DB_FCNTL_LOCKING + *iv_return = DB_FCNTL_LOCKING; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_ENV_CDB_ALLDB", 16)) { + /* ^ */ +#ifdef DB_ENV_CDB_ALLDB + *iv_return = DB_ENV_CDB_ALLDB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_CONFLICT", 16)) { + /* ^ */ +#ifdef DB_LOCK_CONFLICT + *iv_return = DB_LOCK_CONFLICT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_DEADLOCK", 16)) { + /* ^ */ +#ifdef DB_LOCK_DEADLOCK + *iv_return = DB_LOCK_DEADLOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERB_DEADLOCK", 16)) { + /* ^ */ +#ifdef DB_VERB_DEADLOCK + *iv_return = DB_VERB_DEADLOCK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_TXN_LOCK_MASK", 16)) { + /* ^ */ +#ifdef DB_TXN_LOCK_MASK + *iv_return = DB_TXN_LOCK_MASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VRFY_FLAGMASK", 16)) { + /* ^ */ +#ifdef DB_VRFY_FLAGMASK + *iv_return = DB_VRFY_FLAGMASK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_REP_PERMANENT", 16)) { + /* ^ */ +#ifdef DB_REP_PERMANENT + *iv_return = DB_REP_PERMANENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_LOCK_MAXLOCKS", 16)) { + /* ^ */ +#ifdef DB_LOCK_MAXLOCKS + *iv_return = DB_LOCK_MAXLOCKS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_MINLOCKS", 16)) { + /* ^ */ +#ifdef DB_LOCK_MINLOCKS + *iv_return = DB_LOCK_MINLOCKS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_PAGE_NOTFOUND", 16)) { + /* ^ */ +#ifdef DB_PAGE_NOTFOUND + *iv_return = DB_PAGE_NOTFOUND; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_POSTOPEN", 16)) { + /* ^ */ +#ifdef DB_TEST_POSTOPEN + *iv_return = DB_TEST_POSTOPEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERB_CHKPOINT", 16)) { + /* ^ */ +#ifdef DB_VERB_CHKPOINT + *iv_return = DB_VERB_CHKPOINT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_ENV_OVERWRITE", 16)) { + /* ^ */ +#ifdef DB_ENV_OVERWRITE + *iv_return = DB_ENV_OVERWRITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_MINWRITE", 16)) { + /* ^ */ +#ifdef DB_LOCK_MINWRITE + *iv_return = DB_LOCK_MINWRITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_PUT_READ", 16)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 7) + *iv_return = DB_LOCK_PUT_READ; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_LOGC_BUF_SIZE", 16)) { + /* ^ */ +#ifdef DB_LOGC_BUF_SIZE + *iv_return = DB_LOGC_BUF_SIZE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REP_DUPMASTER", 16)) { + /* ^ */ +#ifdef DB_REP_DUPMASTER + *iv_return = DB_REP_DUPMASTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_REP_NEWMASTER", 16)) { + /* ^ */ +#ifdef DB_REP_NEWMASTER + *iv_return = DB_REP_NEWMASTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_POSTSYNC", 16)) { + /* ^ */ +#ifdef DB_TEST_POSTSYNC + *iv_return = DB_TEST_POSTSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERB_WAITSFOR", 16)) { + /* ^ */ +#ifdef DB_VERB_WAITSFOR + *iv_return = DB_VERB_WAITSFOR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_ENV_DIRECT_DB", 16)) { + /* ^ */ +#ifdef DB_ENV_DIRECT_DB + *iv_return = DB_ENV_DIRECT_DB; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_CACHED_COUNTS", 16)) { + /* ^ */ +#ifdef DB_CACHED_COUNTS + *iv_return = DB_CACHED_COUNTS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_MPOOL_PRIVATE", 16)) { + /* ^ */ +#ifdef DB_MPOOL_PRIVATE + *iv_return = DB_MPOOL_PRIVATE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERB_RECOVERY", 16)) { + /* ^ */ +#ifdef DB_VERB_RECOVERY + *iv_return = DB_VERB_RECOVERY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'X': + if (memEQ(name, "DB_LOCK_NOTEXIST", 16)) { + /* ^ */ +#ifdef DB_LOCK_NOTEXIST + *iv_return = DB_LOCK_NOTEXIST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_BROADCAST_EID", 16)) { + /* ^ */ +#ifdef DB_BROADCAST_EID + *iv_return = DB_BROADCAST_EID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_SECONDARY_BAD", 16)) { + /* ^ */ +#ifdef DB_SECONDARY_BAD + *iv_return = DB_SECONDARY_BAD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_17 (pTHX_ const char *name, IV *iv_return, const char **pv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_ENV_DIRECT_LOG DB_ENV_REP_CLIENT DB_ENV_REP_MASTER DB_ENV_STANDALONE + DB_ENV_SYSTEM_MEM DB_ENV_TXN_NOSYNC DB_ENV_USER_ALLOC DB_GET_BOTH_RANGE + DB_LOG_SILENT_ERR DB_RPC_SERVERPROG DB_RPC_SERVERVERS DB_TEST_ELECTINIT + DB_TEST_ELECTSEND DB_TEST_PRERENAME DB_TXN_POPENFILES DB_VERSION_STRING */ + /* Offset 14 gives the best switch position. */ + switch (name[14]) { + case 'A': + if (memEQ(name, "DB_TEST_PRERENAME", 17)) { + /* ^ */ +#ifdef DB_TEST_PRERENAME + *iv_return = DB_TEST_PRERENAME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_ENV_REP_CLIENT", 17)) { + /* ^ */ +#ifdef DB_ENV_REP_CLIENT + *iv_return = DB_ENV_REP_CLIENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOG_SILENT_ERR", 17)) { + /* ^ */ +#ifdef DB_LOG_SILENT_ERR + *iv_return = DB_LOG_SILENT_ERR; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_RPC_SERVERVERS", 17)) { + /* ^ */ +#ifdef DB_RPC_SERVERVERS + *iv_return = DB_RPC_SERVERVERS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_ELECTSEND", 17)) { + /* ^ */ +#ifdef DB_TEST_ELECTSEND + *iv_return = DB_TEST_ELECTSEND; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_VERSION_STRING", 17)) { + /* ^ */ +#ifdef DB_VERSION_STRING + *pv_return = DB_VERSION_STRING; + return PERL_constant_ISPV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_ENV_DIRECT_LOG", 17)) { + /* ^ */ +#ifdef DB_ENV_DIRECT_LOG + *iv_return = DB_ENV_DIRECT_LOG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_USER_ALLOC", 17)) { + /* ^ */ +#ifdef DB_ENV_USER_ALLOC + *iv_return = DB_ENV_USER_ALLOC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_POPENFILES", 17)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 3 && \ + DB_VERSION_PATCH >= 4) + *iv_return = DB_TXN_POPENFILES; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_ENV_SYSTEM_MEM", 17)) { + /* ^ */ +#ifdef DB_ENV_SYSTEM_MEM + *iv_return = DB_ENV_SYSTEM_MEM; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_GET_BOTH_RANGE", 17)) { + /* ^ */ +#ifdef DB_GET_BOTH_RANGE + *iv_return = DB_GET_BOTH_RANGE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_ELECTINIT", 17)) { + /* ^ */ +#ifdef DB_TEST_ELECTINIT + *iv_return = DB_TEST_ELECTINIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_ENV_STANDALONE", 17)) { + /* ^ */ +#ifdef DB_ENV_STANDALONE + *iv_return = DB_ENV_STANDALONE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_RPC_SERVERPROG", 17)) { + /* ^ */ +#ifdef DB_RPC_SERVERPROG + *iv_return = DB_RPC_SERVERPROG; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_ENV_REP_MASTER", 17)) { + /* ^ */ +#ifdef DB_ENV_REP_MASTER + *iv_return = DB_ENV_REP_MASTER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "DB_ENV_TXN_NOSYNC", 17)) { + /* ^ */ +#ifdef DB_ENV_TXN_NOSYNC + *iv_return = DB_ENV_TXN_NOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_18 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_ALREADY_ABORTED DB_ENV_AUTO_COMMIT DB_ENV_OPEN_CALLED + DB_ENV_REGION_INIT DB_LOCK_NOTGRANTED DB_MPOOL_NEW_GROUP + DB_PR_RECOVERYTEST DB_SET_TXN_TIMEOUT DB_TEST_ELECTVOTE1 + DB_TEST_ELECTVOTE2 DB_TEST_ELECTWAIT1 DB_TEST_ELECTWAIT2 + DB_TEST_POSTRENAME DB_TEST_PREDESTROY DB_TEST_PREEXTOPEN */ + /* Offset 13 gives the best switch position. */ + switch (name[13]) { + case 'A': + if (memEQ(name, "DB_ENV_OPEN_CALLED", 18)) { + /* ^ */ +#ifdef DB_ENV_OPEN_CALLED + *iv_return = DB_ENV_OPEN_CALLED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_NOTGRANTED", 18)) { + /* ^ */ +#ifdef DB_LOCK_NOTGRANTED + *iv_return = DB_LOCK_NOTGRANTED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_TEST_POSTRENAME", 18)) { + /* ^ */ +#ifdef DB_TEST_POSTRENAME + *iv_return = DB_TEST_POSTRENAME; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_MPOOL_NEW_GROUP", 18)) { + /* ^ */ +#ifdef DB_MPOOL_NEW_GROUP + *iv_return = DB_MPOOL_NEW_GROUP; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'M': + if (memEQ(name, "DB_SET_TXN_TIMEOUT", 18)) { + /* ^ */ +#ifdef DB_SET_TXN_TIMEOUT + *iv_return = DB_SET_TXN_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_ALREADY_ABORTED", 18)) { + /* ^ */ +#ifdef DB_ALREADY_ABORTED + *iv_return = DB_ALREADY_ABORTED; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_ENV_AUTO_COMMIT", 18)) { + /* ^ */ +#ifdef DB_ENV_AUTO_COMMIT + *iv_return = DB_ENV_AUTO_COMMIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'S': + if (memEQ(name, "DB_TEST_PREDESTROY", 18)) { + /* ^ */ +#ifdef DB_TEST_PREDESTROY + *iv_return = DB_TEST_PREDESTROY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_TEST_PREEXTOPEN", 18)) { + /* ^ */ +#ifdef DB_TEST_PREEXTOPEN + *iv_return = DB_TEST_PREEXTOPEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_TEST_ELECTVOTE1", 18)) { + /* ^ */ +#ifdef DB_TEST_ELECTVOTE1 + *iv_return = DB_TEST_ELECTVOTE1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_ELECTVOTE2", 18)) { + /* ^ */ +#ifdef DB_TEST_ELECTVOTE2 + *iv_return = DB_TEST_ELECTVOTE2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_TEST_ELECTWAIT1", 18)) { + /* ^ */ +#ifdef DB_TEST_ELECTWAIT1 + *iv_return = DB_TEST_ELECTWAIT1; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_ELECTWAIT2", 18)) { + /* ^ */ +#ifdef DB_TEST_ELECTWAIT2 + *iv_return = DB_TEST_ELECTWAIT2; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'Y': + if (memEQ(name, "DB_PR_RECOVERYTEST", 18)) { + /* ^ */ +#ifdef DB_PR_RECOVERYTEST + *iv_return = DB_PR_RECOVERYTEST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_ENV_REGION_INIT", 18)) { + /* ^ */ +#ifdef DB_ENV_REGION_INIT + *iv_return = DB_ENV_REGION_INIT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_19 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_ENV_REP_LOGSONLY DB_LOCK_FREE_LOCKER DB_LOCK_GET_TIMEOUT + DB_LOCK_SET_TIMEOUT DB_PRIORITY_DEFAULT DB_REP_HOLDELECTION + DB_SET_LOCK_TIMEOUT DB_TEST_POSTDESTROY DB_TEST_POSTEXTOPEN + DB_TEST_POSTLOGMETA DB_TEST_SUBDB_LOCKS DB_TXN_FORWARD_ROLL + DB_TXN_LOG_UNDOREDO DB_TXN_WRITE_NOSYNC DB_UNRESOLVED_CHILD + DB_UPDATE_SECONDARY DB_USE_ENVIRON_ROOT DB_VERB_REPLICATION */ + /* Offset 9 gives the best switch position. */ + switch (name[9]) { + case 'C': + if (memEQ(name, "DB_SET_LOCK_TIMEOUT", 19)) { + /* ^ */ +#ifdef DB_SET_LOCK_TIMEOUT + *iv_return = DB_SET_LOCK_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_LOCK_GET_TIMEOUT", 19)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \ + DB_VERSION_PATCH >= 7) + *iv_return = DB_LOCK_GET_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_LOCK_SET_TIMEOUT", 19)) { + /* ^ */ +#ifdef DB_LOCK_SET_TIMEOUT + *iv_return = DB_LOCK_SET_TIMEOUT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_VERB_REPLICATION", 19)) { + /* ^ */ +#ifdef DB_VERB_REPLICATION + *iv_return = DB_VERB_REPLICATION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'G': + if (memEQ(name, "DB_TXN_LOG_UNDOREDO", 19)) { + /* ^ */ +#ifdef DB_TXN_LOG_UNDOREDO + *iv_return = DB_TXN_LOG_UNDOREDO; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'I': + if (memEQ(name, "DB_TXN_WRITE_NOSYNC", 19)) { + /* ^ */ +#ifdef DB_TXN_WRITE_NOSYNC + *iv_return = DB_TXN_WRITE_NOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'L': + if (memEQ(name, "DB_REP_HOLDELECTION", 19)) { + /* ^ */ +#ifdef DB_REP_HOLDELECTION + *iv_return = DB_REP_HOLDELECTION; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_UNRESOLVED_CHILD", 19)) { + /* ^ */ +#ifdef DB_UNRESOLVED_CHILD + *iv_return = DB_UNRESOLVED_CHILD; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_TEST_POSTDESTROY", 19)) { + /* ^ */ +#ifdef DB_TEST_POSTDESTROY + *iv_return = DB_TEST_POSTDESTROY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_POSTEXTOPEN", 19)) { + /* ^ */ +#ifdef DB_TEST_POSTEXTOPEN + *iv_return = DB_TEST_POSTEXTOPEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TEST_POSTLOGMETA", 19)) { + /* ^ */ +#ifdef DB_TEST_POSTLOGMETA + *iv_return = DB_TEST_POSTLOGMETA; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_ENV_REP_LOGSONLY", 19)) { + /* ^ */ +#ifdef DB_ENV_REP_LOGSONLY + *iv_return = DB_ENV_REP_LOGSONLY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_LOCK_FREE_LOCKER", 19)) { + /* ^ */ +#ifdef DB_LOCK_FREE_LOCKER + *iv_return = DB_LOCK_FREE_LOCKER; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_FORWARD_ROLL", 19)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 12) + *iv_return = DB_TXN_FORWARD_ROLL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_PRIORITY_DEFAULT", 19)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_PRIORITY_DEFAULT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_TEST_SUBDB_LOCKS", 19)) { + /* ^ */ +#ifdef DB_TEST_SUBDB_LOCKS + *iv_return = DB_TEST_SUBDB_LOCKS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'V': + if (memEQ(name, "DB_USE_ENVIRON_ROOT", 19)) { + /* ^ */ +#ifdef DB_USE_ENVIRON_ROOT + *iv_return = DB_USE_ENVIRON_ROOT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_UPDATE_SECONDARY", 19)) { + /* ^ */ +#ifdef DB_UPDATE_SECONDARY + *iv_return = DB_UPDATE_SECONDARY; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_20 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_CXX_NO_EXCEPTIONS DB_LOGFILEID_INVALID DB_PANIC_ENVIRONMENT + DB_PRIORITY_VERY_LOW DB_TEST_PREEXTDELETE DB_TEST_PREEXTUNLINK + DB_TXN_BACKWARD_ROLL DB_TXN_LOCK_OPTIMIST */ + /* Offset 14 gives the best switch position. */ + switch (name[14]) { + case 'D': + if (memEQ(name, "DB_TEST_PREEXTDELETE", 20)) { + /* ^ */ +#ifdef DB_TEST_PREEXTDELETE + *iv_return = DB_TEST_PREEXTDELETE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + if (memEQ(name, "DB_TXN_BACKWARD_ROLL", 20)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 12) + *iv_return = DB_TXN_BACKWARD_ROLL; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_LOGFILEID_INVALID", 20)) { + /* ^ */ +#ifdef DB_LOGFILEID_INVALID + *iv_return = DB_LOGFILEID_INVALID; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'O': + if (memEQ(name, "DB_PANIC_ENVIRONMENT", 20)) { + /* ^ */ +#ifdef DB_PANIC_ENVIRONMENT + *iv_return = DB_PANIC_ENVIRONMENT; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_CXX_NO_EXCEPTIONS", 20)) { + /* ^ */ +#ifdef DB_CXX_NO_EXCEPTIONS + *iv_return = DB_CXX_NO_EXCEPTIONS; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'R': + if (memEQ(name, "DB_PRIORITY_VERY_LOW", 20)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_PRIORITY_VERY_LOW; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'T': + if (memEQ(name, "DB_TXN_LOCK_OPTIMIST", 20)) { + /* ^ */ +#ifdef DB_TXN_LOCK_OPTIMIST + *iv_return = DB_TXN_LOCK_OPTIMIST; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'U': + if (memEQ(name, "DB_TEST_PREEXTUNLINK", 20)) { + /* ^ */ +#ifdef DB_TEST_PREEXTUNLINK + *iv_return = DB_TEST_PREEXTUNLINK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant_21 (pTHX_ const char *name, IV *iv_return) { + /* When generated this function returned values for the list of names given + here. However, subsequent manual editing may have added or removed some. + DB_LOCK_UPGRADE_WRITE DB_PRIORITY_VERY_HIGH DB_TEST_POSTEXTDELETE + DB_TEST_POSTEXTUNLINK DB_TXN_BACKWARD_ALLOC */ + /* Offset 16 gives the best switch position. */ + switch (name[16]) { + case 'A': + if (memEQ(name, "DB_TXN_BACKWARD_ALLOC", 21)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_TXN_BACKWARD_ALLOC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'E': + if (memEQ(name, "DB_TEST_POSTEXTDELETE", 21)) { + /* ^ */ +#ifdef DB_TEST_POSTEXTDELETE + *iv_return = DB_TEST_POSTEXTDELETE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'N': + if (memEQ(name, "DB_TEST_POSTEXTUNLINK", 21)) { + /* ^ */ +#ifdef DB_TEST_POSTEXTUNLINK + *iv_return = DB_TEST_POSTEXTUNLINK; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'W': + if (memEQ(name, "DB_LOCK_UPGRADE_WRITE", 21)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 3) || \ + (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 3 && \ + DB_VERSION_PATCH >= 4) + *iv_return = DB_LOCK_UPGRADE_WRITE; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case '_': + if (memEQ(name, "DB_PRIORITY_VERY_HIGH", 21)) { + /* ^ */ +#if (DB_VERSION_MAJOR > 4) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \ + (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \ + DB_VERSION_PATCH >= 17) + *iv_return = DB_PRIORITY_VERY_HIGH; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + +static int +constant (pTHX_ const char *name, STRLEN len, IV *iv_return, const char **pv_return) { + /* Initially switch on the length of the name. */ + /* When generated this function returned values for the list of names given + in this section of perl code. Rather than manually editing these functions + to add or remove constants, which would result in this comment and section + of code becoming inaccurate, we recommend that you edit this section of + code, and use it to regenerate a new set of constant functions which you + then use to replace the originals. + + Regenerate these constant functions by feeding this entire source file to + perl -x + +#!/home/paul/perl/install/redhat6.1/5.8.0/bin/perl5.8.0 -w +use ExtUtils::Constant qw (constant_types C_constant XS_constant); + +my $types = {map {($_, 1)} qw(IV PV)}; +my @names = (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_AUTO_COMMIT DB_BEFORE DB_BROADCAST_EID DB_BTREEMAGIC + DB_BTREEOLDVER DB_BTREEVERSION DB_CACHED_COUNTS DB_CDB_ALLDB + DB_CHECKPOINT DB_CHKSUM_SHA1 DB_CLIENT DB_CL_WRITER DB_COMMIT + DB_CONSUME DB_CONSUME_WAIT DB_CREATE DB_CURLSN DB_CURRENT + DB_CXX_NO_EXCEPTIONS DB_DELETED DB_DELIMITER DB_DIRECT + DB_DIRECT_DB DB_DIRECT_LOG DB_DIRTY_READ DB_DONOTINDEX DB_DUP + DB_DUPCURSOR DB_DUPSORT 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_FATAL DB_ENV_LOCKDOWN + DB_ENV_LOCKING DB_ENV_LOGGING DB_ENV_NOLOCKING DB_ENV_NOMMAP + DB_ENV_NOPANIC DB_ENV_OPEN_CALLED DB_ENV_OVERWRITE + DB_ENV_PANIC_OK DB_ENV_PRIVATE 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_TXN DB_ENV_TXN_NOSYNC + DB_ENV_TXN_WRITE_NOSYNC DB_ENV_USER_ALLOC DB_ENV_YIELDCPU + DB_EXCL DB_EXTENT DB_FAST_STAT DB_FCNTL_LOCKING DB_FILE_ID_LEN + DB_FIRST DB_FIXEDLEN DB_FLUSH DB_FORCE DB_GETREC DB_GET_BOTH + DB_GET_BOTHC DB_GET_BOTH_RANGE DB_GET_RECNO DB_HANDLE_LOCK + DB_HASHMAGIC DB_HASHOLDVER DB_HASHVERSION DB_INCOMPLETE + DB_INIT_CDB DB_INIT_LOCK DB_INIT_LOG DB_INIT_MPOOL DB_INIT_TXN + DB_INVALID_EID 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_CONFLICT + DB_LOCK_DEADLOCK DB_LOCK_DEFAULT DB_LOCK_EXPIRE + DB_LOCK_FREE_LOCKER DB_LOCK_MAXLOCKS 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_RANDOM DB_LOCK_RECORD DB_LOCK_REMOVE DB_LOCK_RIW_N + DB_LOCK_RW_N DB_LOCK_SET_TIMEOUT DB_LOCK_SWITCH DB_LOCK_UPGRADE + DB_LOCK_YOUNGEST DB_LOGC_BUF_SIZE DB_LOGFILEID_INVALID + DB_LOGMAGIC DB_LOGOLDVER DB_LOGVERSION DB_LOG_DISK DB_LOG_LOCKED + DB_LOG_SILENT_ERR DB_MAX_PAGES DB_MAX_RECORDS DB_MPOOL_CLEAN + DB_MPOOL_CREATE DB_MPOOL_DIRTY DB_MPOOL_DISCARD DB_MPOOL_EXTENT + DB_MPOOL_LAST DB_MPOOL_NEW DB_MPOOL_NEW_GROUP DB_MPOOL_PRIVATE + DB_MULTIPLE DB_MULTIPLE_KEY DB_MUTEXDEBUG DB_MUTEXLOCKS + 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_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_PAD DB_PAGEYIELD + DB_PAGE_LOCK DB_PAGE_NOTFOUND DB_PANIC_ENVIRONMENT DB_PERMANENT + DB_POSITION DB_POSITIONI DB_PREV DB_PREV_NODUP DB_PRINTABLE + DB_PRIVATE DB_PR_HEADERS DB_PR_PAGE DB_PR_RECOVERYTEST + DB_QAMMAGIC DB_QAMOLDVER DB_QAMVERSION DB_RDONLY DB_RDWRMASTER + 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_REGISTERED DB_RENAMEMAGIC DB_RENUMBER + DB_REP_CLIENT DB_REP_DUPMASTER DB_REP_HOLDELECTION + DB_REP_LOGSONLY DB_REP_MASTER DB_REP_NEWMASTER DB_REP_NEWSITE + DB_REP_OUTDATED DB_REP_PERMANENT DB_REP_UNAVAIL DB_REVSPLITOFF + DB_RMW DB_RPC_SERVERPROG DB_RPC_SERVERVERS DB_RUNRECOVERY + DB_SALVAGE DB_SECONDARY_BAD DB_SEQUENTIAL DB_SET + DB_SET_LOCK_TIMEOUT DB_SET_RANGE DB_SET_RECNO DB_SET_TXN_NOW + DB_SET_TXN_TIMEOUT DB_SNAPSHOT DB_STAT_CLEAR 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_POSTEXTDELETE DB_TEST_POSTEXTOPEN DB_TEST_POSTEXTUNLINK + DB_TEST_POSTLOG DB_TEST_POSTLOGMETA DB_TEST_POSTOPEN + DB_TEST_POSTRENAME DB_TEST_POSTSYNC DB_TEST_PREDESTROY + DB_TEST_PREEXTDELETE DB_TEST_PREEXTOPEN DB_TEST_PREEXTUNLINK + DB_TEST_PREOPEN DB_TEST_PRERENAME DB_TEST_SUBDB_LOCKS DB_THREAD + DB_TIMEOUT DB_TRUNCATE DB_TXNMAGIC DB_TXNVERSION DB_TXN_CKP + 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_NOWAIT DB_TXN_REDO DB_TXN_SYNC DB_TXN_UNDO + DB_TXN_WRITE_NOSYNC DB_UNRESOLVED_CHILD DB_UPDATE_SECONDARY + DB_UPGRADE DB_USE_ENVIRON DB_USE_ENVIRON_ROOT DB_VERB_CHKPOINT + DB_VERB_DEADLOCK DB_VERB_RECOVERY DB_VERB_REPLICATION + DB_VERB_WAITSFOR DB_VERIFY DB_VERIFY_BAD DB_VERIFY_FATAL + DB_VERSION_MAJOR DB_VERSION_MINOR DB_VERSION_PATCH + DB_VRFY_FLAGMASK DB_WRITECURSOR DB_WRITELOCK DB_WRITEOPEN + DB_WRNOSYNC DB_XA_CREATE DB_XIDDATASIZE DB_YIELDCPU), + {name=>"DB_BTREE", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_HASH", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_DUMP", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_GET", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_GET_TIMEOUT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 7)\n", "#endif\n"]}, + {name=>"DB_LOCK_INHERIT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 7) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 7 && \\\n DB_VERSION_PATCH >= 1)\n", "#endif\n"]}, + {name=>"DB_LOCK_PUT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_PUT_ALL", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_PUT_OBJ", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_LOCK_PUT_READ", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 7)\n", "#endif\n"]}, + {name=>"DB_LOCK_TIMEOUT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 7)\n", "#endif\n"]}, + {name=>"DB_LOCK_TRADE", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_LOCK_UPGRADE_WRITE", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 3 && \\\n DB_VERSION_PATCH >= 4)\n", "#endif\n"]}, + {name=>"DB_PRIORITY_DEFAULT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_PRIORITY_HIGH", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_PRIORITY_LOW", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_PRIORITY_VERY_HIGH", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_PRIORITY_VERY_LOW", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_QUEUE", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 55)\n", "#endif\n"]}, + {name=>"DB_RECNO", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_TXN_ABORT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 12)\n", "#endif\n"]}, + {name=>"DB_TXN_APPLY", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 7)\n", "#endif\n"]}, + {name=>"DB_TXN_BACKWARD_ALLOC", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_TXN_BACKWARD_ROLL", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 12)\n", "#endif\n"]}, + {name=>"DB_TXN_FORWARD_ROLL", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 12)\n", "#endif\n"]}, + {name=>"DB_TXN_GETPGNOS", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_TXN_OPENFILES", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 12)\n", "#endif\n"]}, + {name=>"DB_TXN_POPENFILES", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR > 3) || \\\n (DB_VERSION_MAJOR == 3 && DB_VERSION_MINOR == 3 && \\\n DB_VERSION_PATCH >= 4)\n", "#endif\n"]}, + {name=>"DB_TXN_PRINT", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 4) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR > 1) || \\\n (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR == 1 && \\\n DB_VERSION_PATCH >= 17)\n", "#endif\n"]}, + {name=>"DB_UNKNOWN", type=>"IV", macro=>["#if (DB_VERSION_MAJOR > 2) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR > 0) || \\\n (DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR == 0 && \\\n DB_VERSION_PATCH >= 0)\n", "#endif\n"]}, + {name=>"DB_VERSION_STRING", type=>"PV"}); + +print constant_types(); # macro defs +foreach (C_constant ("BerkeleyDB", 'constant', 'IV', $types, undef, 3, @names) ) { + print $_, "\n"; # C constant subs +} +print "#### XS Section:\n"; +print XS_constant ("BerkeleyDB", $types); +__END__ + */ + + switch (len) { + case 6: + return constant_6 (aTHX_ name, iv_return); + break; + case 7: + return constant_7 (aTHX_ name, iv_return); + break; + case 8: + return constant_8 (aTHX_ name, iv_return); + break; + case 9: + return constant_9 (aTHX_ name, iv_return); + break; + case 10: + return constant_10 (aTHX_ name, iv_return); + break; + case 11: + return constant_11 (aTHX_ name, iv_return); + break; + case 12: + return constant_12 (aTHX_ name, iv_return); + break; + case 13: + return constant_13 (aTHX_ name, iv_return); + break; + case 14: + return constant_14 (aTHX_ name, iv_return); + break; + case 15: + return constant_15 (aTHX_ name, iv_return); + break; + case 16: + return constant_16 (aTHX_ name, iv_return); + break; + case 17: + return constant_17 (aTHX_ name, iv_return, pv_return); + break; + case 18: + return constant_18 (aTHX_ name, iv_return); + break; + case 19: + return constant_19 (aTHX_ name, iv_return); + break; + case 20: + return constant_20 (aTHX_ name, iv_return); + break; + case 21: + return constant_21 (aTHX_ name, iv_return); + break; + case 22: + /* Names all of length 22. */ + /* DB_ENV_RPCCLIENT_GIVEN DB_TXN_LOCK_OPTIMISTIC */ + /* Offset 8 gives the best switch position. */ + switch (name[8]) { + case 'O': + if (memEQ(name, "DB_TXN_LOCK_OPTIMISTIC", 22)) { + /* ^ */ +#ifdef DB_TXN_LOCK_OPTIMISTIC + *iv_return = DB_TXN_LOCK_OPTIMISTIC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + case 'P': + if (memEQ(name, "DB_ENV_RPCCLIENT_GIVEN", 22)) { + /* ^ */ +#ifdef DB_ENV_RPCCLIENT_GIVEN + *iv_return = DB_ENV_RPCCLIENT_GIVEN; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + break; + case 23: + if (memEQ(name, "DB_ENV_TXN_WRITE_NOSYNC", 23)) { +#ifdef DB_ENV_TXN_WRITE_NOSYNC + *iv_return = DB_ENV_TXN_WRITE_NOSYNC; + return PERL_constant_ISIV; +#else + return PERL_constant_NOTDEF; +#endif + } + break; + } + return PERL_constant_NOTFOUND; +} + diff --git a/storage/bdb/perl/BerkeleyDB/constants.xs b/storage/bdb/perl/BerkeleyDB/constants.xs new file mode 100644 index 00000000000..1b2c8b2c3c8 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/constants.xs @@ -0,0 +1,87 @@ +void +constant(sv) + PREINIT: +#ifdef dXSTARG + dXSTARG; /* Faster if we have it. */ +#else + dTARGET; +#endif + STRLEN len; + int type; + IV iv; + /* NV nv; Uncomment this if you need to return NVs */ + const char *pv; + INPUT: + SV * sv; + const char * s = SvPV(sv, len); + PPCODE: + /* Change this to constant(aTHX_ s, len, &iv, &nv); + if you need to return both NVs and IVs */ + type = constant(aTHX_ s, len, &iv, &pv); + /* Return 1 or 2 items. First is error message, or undef if no error. + Second, if present, is found value */ + switch (type) { + case PERL_constant_NOTFOUND: + sv = sv_2mortal(newSVpvf("%s is not a valid BerkeleyDB macro", s)); + PUSHs(sv); + break; + case PERL_constant_NOTDEF: + sv = sv_2mortal(newSVpvf( + "Your vendor has not defined BerkeleyDB macro %s, used", s)); + PUSHs(sv); + break; + case PERL_constant_ISIV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHi(iv); + break; + /* Uncomment this if you need to return NOs + case PERL_constant_ISNO: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_no); + break; */ + /* Uncomment this if you need to return NVs + case PERL_constant_ISNV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHn(nv); + break; */ + case PERL_constant_ISPV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, strlen(pv)); + break; + /* Uncomment this if you need to return PVNs + case PERL_constant_ISPVN: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHp(pv, iv); + break; */ + /* Uncomment this if you need to return SVs + case PERL_constant_ISSV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(sv); + break; */ + /* Uncomment this if you need to return UNDEFs + case PERL_constant_ISUNDEF: + break; */ + /* Uncomment this if you need to return UVs + case PERL_constant_ISUV: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHu((UV)iv); + break; */ + /* Uncomment this if you need to return YESs + case PERL_constant_ISYES: + EXTEND(SP, 1); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_yes); + break; */ + default: + sv = sv_2mortal(newSVpvf( + "Unexpected return type %d while processing BerkeleyDB macro %s, used", + type, s)); + PUSHs(sv); + } diff --git a/storage/bdb/perl/BerkeleyDB/dbinfo b/storage/bdb/perl/BerkeleyDB/dbinfo new file mode 100755 index 00000000000..af2c45facf5 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/dbinfo @@ -0,0 +1,112 @@ +#!/usr/local/bin/perl + +# Name: dbinfo -- identify berkeley DB version used to create +# a database file +# +# Author: Paul Marquess <Paul.Marquess@btinternet.com> +# Version: 1.03 +# Date 17th September 2000 +# +# Copyright (c) 1998-2002 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. + +# Todo: Print more stats on a db file, e.g. no of records +# add log/txn/lock files + +use strict ; + +my %Data = + ( + 0x053162 => { + Type => "Btree", + Versions => + { + 1 => "Unknown (older than 1.71)", + 2 => "Unknown (older than 1.71)", + 3 => "1.71 -> 1.85, 1.86", + 4 => "Unknown", + 5 => "2.0.0 -> 2.3.0", + 6 => "2.3.1 -> 2.7.7", + 7 => "3.0.x", + 8 => "3.1.x -> 4.0.x", + 9 => "4.1.x or greater", + } + }, + 0x061561 => { + Type => "Hash", + Versions => + { + 1 => "Unknown (older than 1.71)", + 2 => "1.71 -> 1.85", + 3 => "1.86", + 4 => "2.0.0 -> 2.1.0", + 5 => "2.2.6 -> 2.7.7", + 6 => "3.0.x", + 7 => "3.1.x -> 4.0.x", + 8 => "4.1.x or greater", + } + }, + 0x042253 => { + Type => "Queue", + Versions => + { + 1 => "3.0.x", + 2 => "3.1.x", + 3 => "3.2.x -> 4.0.x", + 4 => "4.1.x or greater", + } + }, + ) ; + +die "Usage: dbinfo file\n" unless @ARGV == 1 ; + +print "testing file $ARGV[0]...\n\n" ; +open (F, "<$ARGV[0]") or die "Cannot open file $ARGV[0]: $!\n" ; + +my $buff ; +read F, $buff, 20 ; + +my (@info) = unpack("NNNNN", $buff) ; +my (@info1) = unpack("VVVVV", $buff) ; +my ($magic, $version, $endian) ; + +if ($Data{$info[0]}) # first try DB 1.x format +{ + $magic = $info[0] ; + $version = $info[1] ; + $endian = "Unknown" ; +} +elsif ($Data{$info[3]}) # next DB 2.x big endian +{ + $magic = $info[3] ; + $version = $info[4] ; + $endian = "Big Endian" ; +} +elsif ($Data{$info1[3]}) # next DB 2.x little endian +{ + $magic = $info1[3] ; + $version = $info1[4] ; + $endian = "Little Endian" ; +} +else + { die "not a Berkeley DB database file.\n" } + +my $type = $Data{$magic} ; +$magic = sprintf "%06X", $magic ; + +my $ver_string = "Unknown" ; +$ver_string = $type->{Versions}{$version} + if defined $type->{Versions}{$version} ; + +print <<EOM ; +File Type: Berkeley DB $type->{Type} file. +File Version ID: $version +Built with Berkeley DB: $ver_string +Byte Order: $endian +Magic: $magic +EOM + +close F ; + +exit ; diff --git a/storage/bdb/perl/BerkeleyDB/hints/dec_osf.pl b/storage/bdb/perl/BerkeleyDB/hints/dec_osf.pl new file mode 100644 index 00000000000..6d7faeed2e2 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/hints/dec_osf.pl @@ -0,0 +1 @@ +$self->{LIBS} = [ "@{$self->{LIBS}} -lpthreads" ]; diff --git a/storage/bdb/perl/BerkeleyDB/hints/irix_6_5.pl b/storage/bdb/perl/BerkeleyDB/hints/irix_6_5.pl new file mode 100644 index 00000000000..b531673e6e0 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/hints/irix_6_5.pl @@ -0,0 +1 @@ +$self->{LIBS} = [ "@{$self->{LIBS}} -lthread" ]; diff --git a/storage/bdb/perl/BerkeleyDB/hints/solaris.pl b/storage/bdb/perl/BerkeleyDB/hints/solaris.pl new file mode 100644 index 00000000000..ddd941d634a --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/hints/solaris.pl @@ -0,0 +1 @@ +$self->{LIBS} = [ "@{$self->{LIBS}} -lmt" ]; diff --git a/storage/bdb/perl/BerkeleyDB/mkconsts b/storage/bdb/perl/BerkeleyDB/mkconsts new file mode 100644 index 00000000000..7e0964333cc --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/mkconsts @@ -0,0 +1,770 @@ +#!/usr/bin/perl + +use ExtUtils::Constant qw(WriteConstants); + +use constant DEFINE => 'define' ; +use constant STRING => 'string' ; +use constant IGNORE => 'ignore' ; + +%constants = ( + + ######### + # 2.0.0 + ######### + + DBM_INSERT => IGNORE, + DBM_REPLACE => IGNORE, + DBM_SUFFIX => IGNORE, + DB_AFTER => DEFINE, + DB_AM_DUP => IGNORE, + DB_AM_INMEM => IGNORE, + DB_AM_LOCKING => IGNORE, + DB_AM_LOGGING => IGNORE, + DB_AM_MLOCAL => IGNORE, + DB_AM_PGDEF => IGNORE, + DB_AM_RDONLY => IGNORE, + DB_AM_RECOVER => IGNORE, + DB_AM_SWAP => IGNORE, + DB_AM_TXN => IGNORE, + DB_APP_INIT => DEFINE, + DB_BEFORE => DEFINE, + DB_BTREEMAGIC => DEFINE, + DB_BTREEVERSION => DEFINE, + DB_BT_DELIMITER => IGNORE, + DB_BT_EOF => IGNORE, + DB_BT_FIXEDLEN => IGNORE, + DB_BT_PAD => IGNORE, + DB_BT_SNAPSHOT => IGNORE, + DB_CHECKPOINT => DEFINE, + DB_CREATE => DEFINE, + DB_CURRENT => DEFINE, + DB_DBT_INTERNAL => IGNORE, + DB_DBT_MALLOC => IGNORE, + DB_DBT_PARTIAL => IGNORE, + DB_DBT_USERMEM => IGNORE, + DB_DELETED => DEFINE, + DB_DELIMITER => DEFINE, + DB_DUP => DEFINE, + DB_EXCL => DEFINE, + DB_FIRST => DEFINE, + DB_FIXEDLEN => DEFINE, + DB_FLUSH => DEFINE, + DB_HASHMAGIC => DEFINE, + DB_HASHVERSION => DEFINE, + DB_HS_DIRTYMETA => IGNORE, + DB_INCOMPLETE => DEFINE, + DB_INIT_LOCK => DEFINE, + DB_INIT_LOG => DEFINE, + DB_INIT_MPOOL => DEFINE, + DB_INIT_TXN => DEFINE, + DB_KEYEXIST => DEFINE, + DB_KEYFIRST => DEFINE, + DB_KEYLAST => DEFINE, + DB_LAST => DEFINE, + DB_LOCKMAGIC => DEFINE, + DB_LOCKVERSION => DEFINE, + DB_LOCK_DEADLOCK => DEFINE, + DB_LOCK_NOTGRANTED => DEFINE, + DB_LOCK_NOTHELD => DEFINE, + DB_LOCK_NOWAIT => DEFINE, + DB_LOCK_RIW_N => DEFINE, + DB_LOCK_RW_N => DEFINE, + DB_LOGMAGIC => DEFINE, + DB_LOGVERSION => DEFINE, + DB_MAX_PAGES => DEFINE, + DB_MAX_RECORDS => DEFINE, + DB_MPOOL_CLEAN => DEFINE, + DB_MPOOL_CREATE => DEFINE, + DB_MPOOL_DIRTY => DEFINE, + DB_MPOOL_DISCARD => DEFINE, + DB_MPOOL_LAST => DEFINE, + DB_MPOOL_NEW => DEFINE, + DB_MPOOL_PRIVATE => DEFINE, + DB_MUTEXDEBUG => DEFINE, + DB_NEEDSPLIT => DEFINE, + DB_NEXT => DEFINE, + DB_NOOVERWRITE => DEFINE, + DB_NORECURSE => DEFINE, + DB_NOSYNC => DEFINE, + DB_NOTFOUND => DEFINE, + DB_PAD => DEFINE, + DB_PREV => DEFINE, + DB_RDONLY => DEFINE, + DB_REGISTERED => DEFINE, + DB_RE_MODIFIED => IGNORE, + DB_SET => DEFINE, + DB_SET_RANGE => DEFINE, + DB_SNAPSHOT => DEFINE, + DB_SWAPBYTES => DEFINE, + DB_TRUNCATE => DEFINE, + DB_TXNMAGIC => DEFINE, + DB_TXNVERSION => DEFINE, + DB_TXN_BACKWARD_ROLL => DEFINE, + DB_TXN_FORWARD_ROLL => DEFINE, + DB_TXN_LOCK_2PL => DEFINE, + DB_TXN_LOCK_MASK => DEFINE, + DB_TXN_LOCK_OPTIMISTIC => DEFINE, + DB_TXN_LOG_MASK => DEFINE, + DB_TXN_LOG_REDO => DEFINE, + DB_TXN_LOG_UNDO => DEFINE, + DB_TXN_LOG_UNDOREDO => DEFINE, + DB_TXN_OPENFILES => DEFINE, + DB_TXN_REDO => DEFINE, + DB_TXN_UNDO => DEFINE, + DB_USE_ENVIRON => DEFINE, + DB_USE_ENVIRON_ROOT => DEFINE, + DB_VERSION_MAJOR => DEFINE, + DB_VERSION_MINOR => DEFINE, + DB_VERSION_PATCH => DEFINE, + DB_VERSION_STRING => STRING, + _DB_H_ => IGNORE, + __BIT_TYPES_DEFINED__ => IGNORE, + const => IGNORE, + + # enum DBTYPE + DB_BTREE => '2.0.0', + DB_HASH => '2.0.0', + DB_RECNO => '2.0.0', + DB_UNKNOWN => '2.0.0', + + # enum db_lockop_t + DB_LOCK_DUMP => '2.0.0', + DB_LOCK_GET => '2.0.0', + DB_LOCK_PUT => '2.0.0', + DB_LOCK_PUT_ALL => '2.0.0', + DB_LOCK_PUT_OBJ => '2.0.0', + + # enum db_lockmode_t + DB_LOCK_NG => IGNORE, # 2.0.0 + DB_LOCK_READ => IGNORE, # 2.0.0 + DB_LOCK_WRITE => IGNORE, # 2.0.0 + DB_LOCK_IREAD => IGNORE, # 2.0.0 + DB_LOCK_IWRITE => IGNORE, # 2.0.0 + DB_LOCK_IWR => IGNORE, # 2.0.0 + + # enum ACTION + FIND => IGNORE, # 2.0.0 + ENTER => IGNORE, # 2.0.0 + + ######### + # 2.0.3 + ######### + + DB_SEQUENTIAL => DEFINE, + DB_TEMPORARY => DEFINE, + + ######### + # 2.1.0 + ######### + + DB_NOMMAP => DEFINE, + + ######### + # 2.2.6 + ######### + + DB_AM_THREAD => IGNORE, + DB_ARCH_ABS => DEFINE, + DB_ARCH_DATA => DEFINE, + DB_ARCH_LOG => DEFINE, + DB_LOCK_CONFLICT => DEFINE, + DB_LOCK_DEFAULT => DEFINE, + DB_LOCK_NORUN => DEFINE, + DB_LOCK_OLDEST => DEFINE, + DB_LOCK_RANDOM => DEFINE, + DB_LOCK_YOUNGEST => DEFINE, + DB_RECOVER => DEFINE, + DB_RECOVER_FATAL => DEFINE, + DB_THREAD => DEFINE, + DB_TXN_NOSYNC => DEFINE, + + ######### + # 2.3.0 + ######### + + DB_BTREEOLDVER => DEFINE, + DB_BT_RECNUM => IGNORE, + DB_FILE_ID_LEN => DEFINE, + DB_GETREC => DEFINE, + DB_HASHOLDVER => DEFINE, + DB_KEYEMPTY => DEFINE, + DB_LOGOLDVER => DEFINE, + DB_RECNUM => DEFINE, + DB_RECORDCOUNT => DEFINE, + DB_RENUMBER => DEFINE, + DB_RE_DELIMITER => IGNORE, + DB_RE_FIXEDLEN => IGNORE, + DB_RE_PAD => IGNORE, + DB_RE_RENUMBER => IGNORE, + DB_RE_SNAPSHOT => IGNORE, + + ######### + # 2.3.1 + ######### + + DB_GET_RECNO => DEFINE, + DB_SET_RECNO => DEFINE, + + ######### + # 2.3.3 + ######### + + DB_APPEND => DEFINE, + + ######### + # 2.3.6 + ######### + + DB_TXN_CKP => DEFINE, + + ######### + # 2.3.11 + ######### + + DB_ENV_APPINIT => DEFINE, + DB_ENV_STANDALONE => DEFINE, + DB_ENV_THREAD => DEFINE, + + ######### + # 2.3.12 + ######### + + DB_FUNC_CALLOC => IGNORE, + DB_FUNC_CLOSE => IGNORE, + DB_FUNC_DIRFREE => IGNORE, + DB_FUNC_DIRLIST => IGNORE, + DB_FUNC_EXISTS => IGNORE, + DB_FUNC_FREE => IGNORE, + DB_FUNC_FSYNC => IGNORE, + DB_FUNC_IOINFO => IGNORE, + DB_FUNC_MALLOC => IGNORE, + DB_FUNC_MAP => IGNORE, + DB_FUNC_OPEN => IGNORE, + DB_FUNC_READ => IGNORE, + DB_FUNC_REALLOC => IGNORE, + DB_FUNC_SEEK => IGNORE, + DB_FUNC_SLEEP => IGNORE, + DB_FUNC_STRDUP => IGNORE, + DB_FUNC_UNLINK => IGNORE, + DB_FUNC_UNMAP => IGNORE, + DB_FUNC_WRITE => IGNORE, + DB_FUNC_YIELD => IGNORE, + + ######### + # 2.3.14 + ######### + + DB_TSL_SPINS => IGNORE, + + ######### + # 2.3.16 + ######### + + DB_DBM_HSEARCH => IGNORE, + firstkey => IGNORE, + hdestroy => IGNORE, + + ######### + # 2.4.10 + ######### + + DB_CURLSN => DEFINE, + DB_FUNC_RUNLINK => IGNORE, + DB_REGION_ANON => DEFINE, + DB_REGION_INIT => DEFINE, + DB_REGION_NAME => DEFINE, + DB_TXN_LOCK_OPTIMIST => DEFINE, + __CURRENTLY_UNUSED => IGNORE, + + # enum db_status_t + DB_LSTAT_ABORTED => IGNORE, # 2.4.10 + DB_LSTAT_ERR => IGNORE, # 2.4.10 + DB_LSTAT_FREE => IGNORE, # 2.4.10 + DB_LSTAT_HELD => IGNORE, # 2.4.10 + DB_LSTAT_NOGRANT => IGNORE, # 2.4.10 + DB_LSTAT_PENDING => IGNORE, # 2.4.10 + DB_LSTAT_WAITING => IGNORE, # 2.4.10 + + ######### + # 2.4.14 + ######### + + DB_MUTEXLOCKS => DEFINE, + DB_PAGEYIELD => DEFINE, + __UNUSED_100 => IGNORE, + __UNUSED_4000 => IGNORE, + + ######### + # 2.5.2 + ######### + + DBC_CONTINUE => IGNORE, + DBC_KEYSET => IGNORE, + DBC_RECOVER => IGNORE, + DBC_RMW => IGNORE, + DB_DBM_ERROR => IGNORE, + DB_GET_BOTH => DEFINE, + DB_NEXT_DUP => DEFINE, + DB_OPFLAGS_MASK => DEFINE, + DB_RMW => DEFINE, + DB_RUNRECOVERY => DEFINE, + dbmclose => IGNORE, + + ######### + # 2.5.9 + ######### + + DB_DUPSORT => DEFINE, + DB_JOIN_ITEM => DEFINE, + + ######### + # 2.6.4 + ######### + + DBC_WRITER => IGNORE, + DB_AM_CDB => IGNORE, + DB_ENV_CDB => DEFINE, + DB_INIT_CDB => DEFINE, + DB_LOCK_UPGRADE => DEFINE, + DB_WRITELOCK => DEFINE, + + ######### + # 2.7.1 + ######### + + + # enum db_lockop_t + DB_LOCK_INHERIT => '2.7.1', + + ######### + # 2.7.7 + ######### + + DB_FCNTL_LOCKING => DEFINE, + + ######### + # 3.0.55 + ######### + + DBC_WRITECURSOR => IGNORE, + DB_AM_DISCARD => IGNORE, + DB_AM_SUBDB => IGNORE, + DB_BT_REVSPLIT => IGNORE, + DB_CONSUME => DEFINE, + DB_CXX_NO_EXCEPTIONS => DEFINE, + DB_DBT_REALLOC => IGNORE, + DB_DUPCURSOR => DEFINE, + DB_ENV_CREATE => DEFINE, + DB_ENV_DBLOCAL => DEFINE, + DB_ENV_LOCKDOWN => DEFINE, + DB_ENV_LOCKING => DEFINE, + DB_ENV_LOGGING => DEFINE, + DB_ENV_NOMMAP => DEFINE, + DB_ENV_OPEN_CALLED => DEFINE, + DB_ENV_PRIVATE => DEFINE, + DB_ENV_SYSTEM_MEM => DEFINE, + DB_ENV_TXN => DEFINE, + DB_ENV_TXN_NOSYNC => DEFINE, + DB_ENV_USER_ALLOC => DEFINE, + DB_FORCE => DEFINE, + DB_LOCKDOWN => DEFINE, + DB_LOCK_RECORD => DEFINE, + DB_LOGFILEID_INVALID => DEFINE, + DB_MPOOL_NEW_GROUP => DEFINE, + DB_NEXT_NODUP => DEFINE, + DB_OK_BTREE => DEFINE, + DB_OK_HASH => DEFINE, + DB_OK_QUEUE => DEFINE, + DB_OK_RECNO => DEFINE, + DB_OLD_VERSION => DEFINE, + DB_OPEN_CALLED => DEFINE, + DB_PAGE_LOCK => DEFINE, + DB_POSITION => DEFINE, + DB_POSITIONI => DEFINE, + DB_PRIVATE => DEFINE, + DB_QAMMAGIC => DEFINE, + DB_QAMOLDVER => DEFINE, + DB_QAMVERSION => DEFINE, + DB_RECORD_LOCK => DEFINE, + DB_REVSPLITOFF => DEFINE, + DB_SYSTEM_MEM => DEFINE, + DB_TEST_POSTLOG => DEFINE, + DB_TEST_POSTLOGMETA => DEFINE, + DB_TEST_POSTOPEN => DEFINE, + DB_TEST_POSTRENAME => DEFINE, + DB_TEST_POSTSYNC => DEFINE, + DB_TEST_PREOPEN => DEFINE, + DB_TEST_PRERENAME => DEFINE, + DB_TXN_NOWAIT => DEFINE, + DB_TXN_SYNC => DEFINE, + DB_UPGRADE => DEFINE, + DB_VERB_CHKPOINT => DEFINE, + DB_VERB_DEADLOCK => DEFINE, + DB_VERB_RECOVERY => DEFINE, + DB_VERB_WAITSFOR => DEFINE, + DB_WRITECURSOR => DEFINE, + DB_XA_CREATE => DEFINE, + + # enum DBTYPE + DB_QUEUE => '3.0.55', + + ######### + # 3.1.12 + ######### + + DBC_ACTIVE => IGNORE, + DBC_OPD => IGNORE, + DBC_TRANSIENT => IGNORE, + DBC_WRITEDUP => IGNORE, + DB_AGGRESSIVE => DEFINE, + DB_AM_DUPSORT => IGNORE, + DB_CACHED_COUNTS => DEFINE, + DB_CLIENT => DEFINE, + DB_DBT_DUPOK => IGNORE, + DB_DBT_ISSET => IGNORE, + DB_ENV_RPCCLIENT => DEFINE, + DB_GET_BOTHC => DEFINE, + DB_JOIN_NOSORT => DEFINE, + DB_NODUPDATA => DEFINE, + DB_NOORDERCHK => DEFINE, + DB_NOSERVER => DEFINE, + DB_NOSERVER_HOME => DEFINE, + DB_NOSERVER_ID => DEFINE, + DB_ODDFILESIZE => DEFINE, + DB_ORDERCHKONLY => DEFINE, + DB_PREV_NODUP => DEFINE, + DB_PR_HEADERS => DEFINE, + DB_PR_PAGE => DEFINE, + DB_PR_RECOVERYTEST => DEFINE, + DB_RDWRMASTER => DEFINE, + DB_SALVAGE => DEFINE, + DB_VERIFY_BAD => DEFINE, + DB_VERIFY_FATAL => DEFINE, + DB_VRFY_FLAGMASK => DEFINE, + + # enum db_recops + DB_TXN_ABORT => '3.1.12', + DB_TXN_BACKWARD_ROLL => '3.1.12', + DB_TXN_FORWARD_ROLL => '3.1.12', + DB_TXN_OPENFILES => '3.1.12', + + ######### + # 3.2.3 + ######### + + DBC_COMPENSATE => IGNORE, + DB_AM_VERIFYING => IGNORE, + DB_CDB_ALLDB => DEFINE, + DB_ENV_CDB_ALLDB => DEFINE, + DB_EXTENT => DEFINE, + DB_JOINENV => DEFINE, + DB_LOCK_SWITCH => DEFINE, + DB_MPOOL_EXTENT => DEFINE, + DB_REGION_MAGIC => DEFINE, + DB_UNRESOLVED_CHILD => DEFINE, + DB_VERIFY => DEFINE, + + # enum db_notices + DB_NOTICE_LOGFILE_CHANGED => IGNORE, # 3.2.3 + + ######### + # 3.2.6 + ######### + + DB_ALREADY_ABORTED => DEFINE, + DB_CONSUME_WAIT => DEFINE, + DB_JAVA_CALLBACK => DEFINE, + DB_TEST_POSTEXTDELETE => DEFINE, + DB_TEST_POSTEXTOPEN => DEFINE, + DB_TEST_POSTEXTUNLINK => DEFINE, + DB_TEST_PREEXTDELETE => DEFINE, + DB_TEST_PREEXTOPEN => DEFINE, + DB_TEST_PREEXTUNLINK => DEFINE, + + # enum db_lockmode_t + DB_LOCK_WAIT => IGNORE, # 3.2.6 + + ######### + # 3.3.4 + ######### + + DBC_DIRTY_READ => IGNORE, + DBC_MULTIPLE => IGNORE, + DBC_MULTIPLE_KEY => IGNORE, + DB_AM_DIRTY => IGNORE, + DB_AM_SECONDARY => IGNORE, + DB_COMMIT => DEFINE, + DB_DBT_APPMALLOC => IGNORE, + DB_DIRTY_READ => DEFINE, + DB_DONOTINDEX => DEFINE, + DB_ENV_PANIC_OK => DEFINE, + DB_ENV_RPCCLIENT_GIVEN => DEFINE, + DB_FAST_STAT => DEFINE, + DB_LOCK_MAXLOCKS => DEFINE, + DB_LOCK_MINLOCKS => DEFINE, + DB_LOCK_MINWRITE => DEFINE, + DB_MULTIPLE => DEFINE, + DB_MULTIPLE_KEY => DEFINE, + DB_PAGE_NOTFOUND => DEFINE, + DB_RPC_SERVERPROG => DEFINE, + DB_RPC_SERVERVERS => DEFINE, + DB_UPDATE_SECONDARY => DEFINE, + DB_XIDDATASIZE => DEFINE, + + # enum db_recops + DB_TXN_POPENFILES => '3.3.4', + + # enum db_lockop_t + DB_LOCK_UPGRADE_WRITE => '3.3.4', + + # enum db_lockmode_t + DB_LOCK_DIRTY => IGNORE, # 3.3.4 + DB_LOCK_WWRITE => IGNORE, # 3.3.4 + + ######### + # 3.3.11 + ######### + + DB_SECONDARY_BAD => DEFINE, + DB_SURPRISE_KID => DEFINE, + DB_TEST_POSTDESTROY => DEFINE, + DB_TEST_PREDESTROY => DEFINE, + + ######### + # 4.0.7 + ######### + + DB_APPLY_LOGREG => DEFINE, + DB_BROADCAST_EID => DEFINE, + DB_CL_WRITER => DEFINE, + DB_ENV_NOLOCKING => DEFINE, + DB_ENV_NOPANIC => DEFINE, + DB_ENV_REGION_INIT => DEFINE, + DB_ENV_REP_CLIENT => DEFINE, + DB_ENV_REP_LOGSONLY => DEFINE, + DB_ENV_REP_MASTER => DEFINE, + DB_ENV_YIELDCPU => DEFINE, + DB_GET_BOTH_RANGE => DEFINE, + DB_INVALID_EID => DEFINE, + DB_LOCK_EXPIRE => DEFINE, + DB_LOCK_FREE_LOCKER => DEFINE, + DB_LOCK_SET_TIMEOUT => DEFINE, + DB_LOGC_BUF_SIZE => DEFINE, + DB_LOG_DISK => DEFINE, + DB_LOG_LOCKED => DEFINE, + DB_LOG_SILENT_ERR => DEFINE, + DB_NOLOCKING => DEFINE, + DB_NOPANIC => DEFINE, + DB_PANIC_ENVIRONMENT => DEFINE, + DB_REP_CLIENT => DEFINE, + DB_REP_DUPMASTER => DEFINE, + DB_REP_HOLDELECTION => DEFINE, + DB_REP_LOGSONLY => DEFINE, + DB_REP_MASTER => DEFINE, + DB_REP_NEWMASTER => DEFINE, + DB_REP_NEWSITE => DEFINE, + DB_REP_OUTDATED => DEFINE, + DB_REP_PERMANENT => DEFINE, + DB_REP_UNAVAIL => DEFINE, + DB_SET_LOCK_TIMEOUT => DEFINE, + DB_SET_TXN_NOW => DEFINE, + DB_SET_TXN_TIMEOUT => DEFINE, + DB_STAT_CLEAR => DEFINE, + DB_TIMEOUT => DEFINE, + DB_YIELDCPU => DEFINE, + MP_FLUSH => IGNORE, + MP_OPEN_CALLED => IGNORE, + MP_READONLY => IGNORE, + MP_UPGRADE => IGNORE, + MP_UPGRADE_FAIL => IGNORE, + TXN_CHILDCOMMIT => IGNORE, + TXN_COMPENSATE => IGNORE, + TXN_DIRTY_READ => IGNORE, + TXN_LOCKTIMEOUT => IGNORE, + TXN_MALLOC => IGNORE, + TXN_NOSYNC => IGNORE, + TXN_NOWAIT => IGNORE, + TXN_SYNC => IGNORE, + + # enum db_recops + DB_TXN_APPLY => '4.0.7', + + # enum db_lockop_t + DB_LOCK_GET_TIMEOUT => '4.0.7', + DB_LOCK_PUT_READ => '4.0.7', + DB_LOCK_TIMEOUT => '4.0.7', + + # enum db_status_t + DB_LSTAT_EXPIRED => IGNORE, # 4.0.7 + + ######### + # 4.0.14 + ######### + + DB_EID_BROADCAST => DEFINE, + DB_EID_INVALID => DEFINE, + DB_VERB_REPLICATION => DEFINE, + + ######### + # 4.1.17 + ######### + + DBC_OWN_LID => IGNORE, + DB_AM_CHKSUM => IGNORE, + DB_AM_CL_WRITER => IGNORE, + DB_AM_COMPENSATE => IGNORE, + DB_AM_CREATED => IGNORE, + DB_AM_CREATED_MSTR => IGNORE, + DB_AM_DBM_ERROR => IGNORE, + DB_AM_DELIMITER => IGNORE, + DB_AM_ENCRYPT => IGNORE, + DB_AM_FIXEDLEN => IGNORE, + DB_AM_IN_RENAME => IGNORE, + DB_AM_OPEN_CALLED => IGNORE, + DB_AM_PAD => IGNORE, + DB_AM_RECNUM => IGNORE, + DB_AM_RENUMBER => IGNORE, + DB_AM_REVSPLITOFF => IGNORE, + DB_AM_SNAPSHOT => IGNORE, + DB_AUTO_COMMIT => DEFINE, + DB_CHKSUM_SHA1 => DEFINE, + DB_DIRECT => DEFINE, + DB_DIRECT_DB => DEFINE, + DB_DIRECT_LOG => DEFINE, + DB_ENCRYPT => DEFINE, + DB_ENCRYPT_AES => DEFINE, + DB_ENV_AUTO_COMMIT => DEFINE, + DB_ENV_DIRECT_DB => DEFINE, + DB_ENV_DIRECT_LOG => DEFINE, + DB_ENV_FATAL => DEFINE, + DB_ENV_OVERWRITE => DEFINE, + DB_ENV_TXN_WRITE_NOSYNC => DEFINE, + DB_HANDLE_LOCK => DEFINE, + DB_LOCK_NOTEXIST => DEFINE, + DB_LOCK_REMOVE => DEFINE, + DB_NOCOPY => DEFINE, + DB_OVERWRITE => DEFINE, + DB_PERMANENT => DEFINE, + DB_PRINTABLE => DEFINE, + DB_RENAMEMAGIC => DEFINE, + DB_TEST_ELECTINIT => DEFINE, + DB_TEST_ELECTSEND => DEFINE, + DB_TEST_ELECTVOTE1 => DEFINE, + DB_TEST_ELECTVOTE2 => DEFINE, + DB_TEST_ELECTWAIT1 => DEFINE, + DB_TEST_ELECTWAIT2 => DEFINE, + DB_TEST_SUBDB_LOCKS => DEFINE, + DB_TXN_LOCK => DEFINE, + DB_TXN_WRITE_NOSYNC => DEFINE, + DB_WRITEOPEN => DEFINE, + DB_WRNOSYNC => DEFINE, + _DB_EXT_PROT_IN_ => IGNORE, + + # enum db_lockop_t + DB_LOCK_TRADE => '4.1.17', + + # enum db_status_t + DB_LSTAT_NOTEXIST => IGNORE, # 4.1.17 + + # enum DB_CACHE_PRIORITY + DB_PRIORITY_VERY_LOW => '4.1.17', + DB_PRIORITY_LOW => '4.1.17', + DB_PRIORITY_DEFAULT => '4.1.17', + DB_PRIORITY_HIGH => '4.1.17', + DB_PRIORITY_VERY_HIGH => '4.1.17', + + # enum db_recops + DB_TXN_BACKWARD_ALLOC => '4.1.17', + DB_TXN_GETPGNOS => '4.1.17', + DB_TXN_PRINT => '4.1.17', + + ) ; + +sub enum_Macro +{ + my $str = shift ; + my ($major, $minor, $patch) = split /\./, $str ; + + my $macro = + "#if (DB_VERSION_MAJOR > $major) || \\\n" . + " (DB_VERSION_MAJOR == $major && DB_VERSION_MINOR > $minor) || \\\n" . + " (DB_VERSION_MAJOR == $major && DB_VERSION_MINOR == $minor && \\\n" . + " DB_VERSION_PATCH >= $patch)\n" ; + + return $macro; + +} + +sub OutputXS +{ + + my @names = () ; + + foreach my $key (sort keys %constants) + { + my $val = $constants{$key} ; + next if $val eq IGNORE; + + if ($val eq STRING) + { push @names, { name => $key, type => "PV" } } + elsif ($val eq DEFINE) + { push @names, $key } + else + { push @names, { name => $key, macro => [enum_Macro($val), "#endif\n"] } } + } + + warn "Updating constants.xs & constants.h...\n"; + WriteConstants( + NAME => BerkeleyDB, + NAMES => \@names, + C_FILE => 'constants.h', + XS_FILE => 'constants.xs', + ) ; +} + +sub OutputPM +{ + my $filename = 'BerkeleyDB.pm'; + warn "Updating $filename...\n"; + open IN, "<$filename" || die "Cannot open $filename: $!\n"; + open OUT, ">$filename.tmp" || die "Cannot open $filename.tmp: $!\n"; + + my $START = '@EXPORT = qw(' ; + my $START_re = quotemeta $START ; + my $END = ');'; + my $END_re = quotemeta $END ; + + # skip to the @EXPORT declaration + OUTER: while (<IN>) + { + if ( /^\s*$START_re/ ) + { + # skip to the end marker. + while (<IN>) + { last OUTER if /^\s*$END_re/ } + } + print OUT ; + } + + print OUT "$START\n"; + foreach my $key (sort keys %constants) + { + next if $constants{$key} eq IGNORE; + print OUT "\t$key\n"; + } + print OUT "\t$END\n"; + + while (<IN>) + { + print OUT ; + } + + close IN; + close OUT; + + rename $filename, "$filename.bak" || die "Cannot rename $filename: $!\n" ; + rename "$filename.tmp", $filename || die "Cannot rename $filename.tmp: $!\n" ; +} + +OutputXS() ; +OutputPM() ; diff --git a/storage/bdb/perl/BerkeleyDB/mkpod b/storage/bdb/perl/BerkeleyDB/mkpod new file mode 100755 index 00000000000..44bbf3fbf4f --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/mkpod @@ -0,0 +1,146 @@ +#!/usr/local/bin/perl5 + +# Filename: mkpod +# +# Author: Paul Marquess + +# File types +# +# Macro files end with .M +# Tagged source files end with .T +# Output from the code ends with .O +# Pre-Pod file ends with .P +# +# Tags +# +# ## BEGIN tagname +# ... +# ## END tagname +# +# ## 0 +# ## 1 +# + +# Constants + +$TOKEN = '##' ; +$Verbose = 1 if $ARGV[0] =~ /^-v/i ; + +# Macros files first +foreach $file (glob("*.M")) +{ + open (F, "<$file") or die "Cannot open '$file':$!\n" ; + print " Processing Macro file $file\n" ; + while (<F>) + { + # Skip blank & comment lines + next if /^\s*$/ || /^\s*#/ ; + + # + ($name, $expand) = split (/\t+/, $_, 2) ; + + $expand =~ s/^\s*// ; + $expand =~ s/\s*$// ; + + if ($expand =~ /\[#/ ) + { + } + + $Macros{$name} = $expand ; + } + close F ; +} + +# Suck up all the code files +foreach $file (glob("t/*.T")) +{ + ($newfile = $file) =~ s/\.T$// ; + open (F, "<$file") or die "Cannot open '$file':$!\n" ; + open (N, ">$newfile") or die "Cannot open '$newfile':$!\n" ; + + print " Processing $file -> $newfile\n" ; + + while ($line = <F>) + { + if ($line =~ /^$TOKEN\s*BEGIN\s+(\w+)\s*$/ or + $line =~ m[\s*/\*$TOKEN\s*BEGIN\s+(\w+)\s*$] ) + { + print " Section $1 begins\n" if $Verbose ; + $InSection{$1} ++ ; + $Section{$1} = '' unless $Section{$1} ; + } + elsif ($line =~ /^$TOKEN\s*END\s+(\w+)\s*$/ or + $line =~ m[^\s*/\*$TOKEN\s*END\s+(\w+)\s*$] ) + { + warn "Encountered END without a begin [$line]\n" + unless $InSection{$1} ; + + delete $InSection{$1} ; + print " Section $1 ends\n" if $Verbose ; + } + else + { + print N $line ; + chop $line ; + $line =~ s/\s*$// ; + + # Save the current line in each of the sections + foreach( keys %InSection) + { + if ($line !~ /^\s*$/ ) + #{ $Section{$_} .= " $line" } + { $Section{$_} .= $line } + $Section{$_} .= "\n" ; + } + } + + } + + if (%InSection) + { + # Check for unclosed sections + print "The following Sections are not terminated\n" ; + foreach (sort keys %InSection) + { print "\t$_\n" } + exit 1 ; + } + + close F ; + close N ; +} + +print "\n\nCreating pod file(s)\n\n" if $Verbose ; + +@ppods = glob('*.P') ; +#$ppod = $ARGV[0] ; +#$pod = $ARGV[1] ; + +# Now process the pre-pod file +foreach $ppod (@ppods) +{ + ($pod = $ppod) =~ s/\.P$// ; + open (PPOD, "<$ppod") or die "Cannot open file '$ppod': $!\n" ; + open (POD, ">$pod") or die "Cannot open file '$pod': $!\n" ; + + print " $ppod -> $pod\n" ; + + while ($line = <PPOD>) + { + if ( $line =~ /^\s*$TOKEN\s*(\w+)\s*$/) + { + warn "No code insert '$1' available\n" + unless $Section{$1} ; + + print "Expanding section $1\n" if $Verbose ; + print POD $Section{$1} ; + } + else + { +# $line =~ s/\[#([^\]])]/$Macros{$1}/ge ; + print POD $line ; + } + } + + close PPOD ; + close POD ; +} diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004 b/storage/bdb/perl/BerkeleyDB/patches/5.004 new file mode 100644 index 00000000000..143ec95afbc --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004 @@ -0,0 +1,44 @@ +diff perl5.004.orig/Configure perl5.004/Configure +190a191 +> perllibs='' +9904a9906,9913 +> : Remove libraries needed only for extensions +> : The appropriate ext/Foo/Makefile.PL will add them back in, if +> : necessary. +> set X `echo " $libs " | +> sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` +> shift +> perllibs="$*" +> +10372a10382 +> perllibs='$perllibs' +diff perl5.004.orig/Makefile.SH perl5.004/Makefile.SH +122c122 +< libs = $libs $cryptlib +--- +> libs = $perllibs $cryptlib +Common subdirectories: perl5.004.orig/Porting and perl5.004/Porting +Common subdirectories: perl5.004.orig/cygwin32 and perl5.004/cygwin32 +Common subdirectories: perl5.004.orig/eg and perl5.004/eg +Common subdirectories: perl5.004.orig/emacs and perl5.004/emacs +Common subdirectories: perl5.004.orig/ext and perl5.004/ext +Common subdirectories: perl5.004.orig/h2pl and perl5.004/h2pl +Common subdirectories: perl5.004.orig/hints and perl5.004/hints +Common subdirectories: perl5.004.orig/lib and perl5.004/lib +diff perl5.004.orig/myconfig perl5.004/myconfig +38c38 +< libs=$libs +--- +> libs=$perllibs +Common subdirectories: perl5.004.orig/os2 and perl5.004/os2 +diff perl5.004.orig/patchlevel.h perl5.004/patchlevel.h +40a41 +> ,"NODB-1.0 - remove -ldb from core perl binary." +Common subdirectories: perl5.004.orig/plan9 and perl5.004/plan9 +Common subdirectories: perl5.004.orig/pod and perl5.004/pod +Common subdirectories: perl5.004.orig/qnx and perl5.004/qnx +Common subdirectories: perl5.004.orig/t and perl5.004/t +Common subdirectories: perl5.004.orig/utils and perl5.004/utils +Common subdirectories: perl5.004.orig/vms and perl5.004/vms +Common subdirectories: perl5.004.orig/win32 and perl5.004/win32 +Common subdirectories: perl5.004.orig/x2p and perl5.004/x2p diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004_01 b/storage/bdb/perl/BerkeleyDB/patches/5.004_01 new file mode 100644 index 00000000000..1b05eb4e02b --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004_01 @@ -0,0 +1,217 @@ +diff -rc perl5.004_01.orig/Configure perl5.004_01/Configure +*** perl5.004_01.orig/Configure Wed Jun 11 00:28:03 1997 +--- perl5.004_01/Configure Sun Nov 12 22:12:35 2000 +*************** +*** 188,193 **** +--- 188,194 ---- + mv='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 9907,9912 **** +--- 9908,9921 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 10375,10380 **** +--- 10384,10390 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.004_01.orig/Makefile.SH perl5.004_01/Makefile.SH +*** perl5.004_01.orig/Makefile.SH Thu Jun 12 23:27:56 1997 +--- perl5.004_01/Makefile.SH Sun Nov 12 22:12:35 2000 +*************** +*** 126,132 **** + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 126,132 ---- + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.004_01.orig/lib/ExtUtils/Embed.pm perl5.004_01/lib/ExtUtils/Embed.pm +*** perl5.004_01.orig/lib/ExtUtils/Embed.pm Wed Apr 2 22:12:04 1997 +--- perl5.004_01/lib/ExtUtils/Embed.pm Sun Nov 12 22:12:35 2000 +*************** +*** 170,176 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 170,176 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.004_01.orig/lib/ExtUtils/Liblist.pm perl5.004_01/lib/ExtUtils/Liblist.pm +*** perl5.004_01.orig/lib/ExtUtils/Liblist.pm Sat Jun 7 01:19:44 1997 +--- perl5.004_01/lib/ExtUtils/Liblist.pm Sun Nov 12 22:13:27 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $Verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $Verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $Verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 186,196 **** + my($self, $potential_libs, $Verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{libs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +--- 186,196 ---- + my($self, $potential_libs, $Verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{perllibs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +*************** +*** 540,546 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 540,546 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.004_01.orig/lib/ExtUtils/MM_Unix.pm perl5.004_01/lib/ExtUtils/MM_Unix.pm +*** perl5.004_01.orig/lib/ExtUtils/MM_Unix.pm Thu Jun 12 22:06:18 1997 +--- perl5.004_01/lib/ExtUtils/MM_Unix.pm Sun Nov 12 22:12:35 2000 +*************** +*** 2137,2143 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2137,2143 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.004_01.orig/myconfig perl5.004_01/myconfig +*** perl5.004_01.orig/myconfig Sat Dec 21 01:13:20 1996 +--- perl5.004_01/myconfig Sun Nov 12 22:12:35 2000 +*************** +*** 35,41 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +--- 35,41 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +diff -rc perl5.004_01.orig/patchlevel.h perl5.004_01/patchlevel.h +*** perl5.004_01.orig/patchlevel.h Wed Jun 11 03:06:10 1997 +--- perl5.004_01/patchlevel.h Sun Nov 12 22:12:35 2000 +*************** +*** 38,43 **** +--- 38,44 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004_02 b/storage/bdb/perl/BerkeleyDB/patches/5.004_02 new file mode 100644 index 00000000000..238f8737941 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004_02 @@ -0,0 +1,217 @@ +diff -rc perl5.004_02.orig/Configure perl5.004_02/Configure +*** perl5.004_02.orig/Configure Thu Aug 7 15:08:44 1997 +--- perl5.004_02/Configure Sun Nov 12 22:06:24 2000 +*************** +*** 188,193 **** +--- 188,194 ---- + mv='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 9911,9916 **** +--- 9912,9925 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 10379,10384 **** +--- 10388,10394 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.004_02.orig/Makefile.SH perl5.004_02/Makefile.SH +*** perl5.004_02.orig/Makefile.SH Thu Aug 7 13:10:53 1997 +--- perl5.004_02/Makefile.SH Sun Nov 12 22:06:24 2000 +*************** +*** 126,132 **** + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 126,132 ---- + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.004_02.orig/lib/ExtUtils/Embed.pm perl5.004_02/lib/ExtUtils/Embed.pm +*** perl5.004_02.orig/lib/ExtUtils/Embed.pm Fri Aug 1 15:08:44 1997 +--- perl5.004_02/lib/ExtUtils/Embed.pm Sun Nov 12 22:06:24 2000 +*************** +*** 178,184 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 178,184 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.004_02.orig/lib/ExtUtils/Liblist.pm perl5.004_02/lib/ExtUtils/Liblist.pm +*** perl5.004_02.orig/lib/ExtUtils/Liblist.pm Fri Aug 1 19:36:58 1997 +--- perl5.004_02/lib/ExtUtils/Liblist.pm Sun Nov 12 22:06:24 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 186,196 **** + my($self, $potential_libs, $verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{libs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +--- 186,196 ---- + my($self, $potential_libs, $verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{perllibs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +*************** +*** 540,546 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 540,546 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.004_02.orig/lib/ExtUtils/MM_Unix.pm perl5.004_02/lib/ExtUtils/MM_Unix.pm +*** perl5.004_02.orig/lib/ExtUtils/MM_Unix.pm Tue Aug 5 14:28:08 1997 +--- perl5.004_02/lib/ExtUtils/MM_Unix.pm Sun Nov 12 22:06:25 2000 +*************** +*** 2224,2230 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2224,2230 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.004_02.orig/myconfig perl5.004_02/myconfig +*** perl5.004_02.orig/myconfig Sat Dec 21 01:13:20 1996 +--- perl5.004_02/myconfig Sun Nov 12 22:06:25 2000 +*************** +*** 35,41 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +--- 35,41 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +diff -rc perl5.004_02.orig/patchlevel.h perl5.004_02/patchlevel.h +*** perl5.004_02.orig/patchlevel.h Fri Aug 1 15:07:34 1997 +--- perl5.004_02/patchlevel.h Sun Nov 12 22:06:25 2000 +*************** +*** 38,43 **** +--- 38,44 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004_03 b/storage/bdb/perl/BerkeleyDB/patches/5.004_03 new file mode 100644 index 00000000000..06331eac922 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004_03 @@ -0,0 +1,223 @@ +diff -rc perl5.004_03.orig/Configure perl5.004_03/Configure +*** perl5.004_03.orig/Configure Wed Aug 13 16:09:46 1997 +--- perl5.004_03/Configure Sun Nov 12 21:56:18 2000 +*************** +*** 188,193 **** +--- 188,194 ---- + mv='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 9911,9916 **** +--- 9912,9925 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 10379,10384 **** +--- 10388,10394 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +Only in perl5.004_03: Configure.orig +diff -rc perl5.004_03.orig/Makefile.SH perl5.004_03/Makefile.SH +*** perl5.004_03.orig/Makefile.SH Mon Aug 18 19:24:29 1997 +--- perl5.004_03/Makefile.SH Sun Nov 12 21:56:18 2000 +*************** +*** 126,132 **** + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 126,132 ---- + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +Only in perl5.004_03: Makefile.SH.orig +diff -rc perl5.004_03.orig/lib/ExtUtils/Embed.pm perl5.004_03/lib/ExtUtils/Embed.pm +*** perl5.004_03.orig/lib/ExtUtils/Embed.pm Fri Aug 1 15:08:44 1997 +--- perl5.004_03/lib/ExtUtils/Embed.pm Sun Nov 12 21:56:18 2000 +*************** +*** 178,184 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 178,184 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.004_03.orig/lib/ExtUtils/Liblist.pm perl5.004_03/lib/ExtUtils/Liblist.pm +*** perl5.004_03.orig/lib/ExtUtils/Liblist.pm Fri Aug 1 19:36:58 1997 +--- perl5.004_03/lib/ExtUtils/Liblist.pm Sun Nov 12 21:57:17 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + print STDOUT "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 186,196 **** + my($self, $potential_libs, $verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{libs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +--- 186,196 ---- + my($self, $potential_libs, $verbose) = @_; + + # If user did not supply a list, we punt. +! # (caller should probably use the list in $Config{perllibs}) + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +*************** +*** 540,546 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 540,546 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +Only in perl5.004_03/lib/ExtUtils: Liblist.pm.orig +Only in perl5.004_03/lib/ExtUtils: Liblist.pm.rej +diff -rc perl5.004_03.orig/lib/ExtUtils/MM_Unix.pm perl5.004_03/lib/ExtUtils/MM_Unix.pm +*** perl5.004_03.orig/lib/ExtUtils/MM_Unix.pm Mon Aug 18 19:16:12 1997 +--- perl5.004_03/lib/ExtUtils/MM_Unix.pm Sun Nov 12 21:56:19 2000 +*************** +*** 2224,2230 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2224,2230 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +Only in perl5.004_03/lib/ExtUtils: MM_Unix.pm.orig +diff -rc perl5.004_03.orig/myconfig perl5.004_03/myconfig +*** perl5.004_03.orig/myconfig Sat Dec 21 01:13:20 1996 +--- perl5.004_03/myconfig Sun Nov 12 21:56:19 2000 +*************** +*** 35,41 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +--- 35,41 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +diff -rc perl5.004_03.orig/patchlevel.h perl5.004_03/patchlevel.h +*** perl5.004_03.orig/patchlevel.h Wed Aug 13 11:42:01 1997 +--- perl5.004_03/patchlevel.h Sun Nov 12 21:56:19 2000 +*************** +*** 38,43 **** +--- 38,44 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + +Only in perl5.004_03: patchlevel.h.orig diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004_04 b/storage/bdb/perl/BerkeleyDB/patches/5.004_04 new file mode 100644 index 00000000000..a227dc700d9 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004_04 @@ -0,0 +1,209 @@ +diff -rc perl5.004_04.orig/Configure perl5.004_04/Configure +*** perl5.004_04.orig/Configure Fri Oct 3 18:57:39 1997 +--- perl5.004_04/Configure Sun Nov 12 21:50:51 2000 +*************** +*** 188,193 **** +--- 188,194 ---- + mv='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 9910,9915 **** +--- 9911,9924 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 10378,10383 **** +--- 10387,10393 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.004_04.orig/Makefile.SH perl5.004_04/Makefile.SH +*** perl5.004_04.orig/Makefile.SH Wed Oct 15 10:33:16 1997 +--- perl5.004_04/Makefile.SH Sun Nov 12 21:50:51 2000 +*************** +*** 129,135 **** + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 129,135 ---- + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.004_04.orig/lib/ExtUtils/Embed.pm perl5.004_04/lib/ExtUtils/Embed.pm +*** perl5.004_04.orig/lib/ExtUtils/Embed.pm Fri Aug 1 15:08:44 1997 +--- perl5.004_04/lib/ExtUtils/Embed.pm Sun Nov 12 21:50:51 2000 +*************** +*** 178,184 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 178,184 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.004_04.orig/lib/ExtUtils/Liblist.pm perl5.004_04/lib/ExtUtils/Liblist.pm +*** perl5.004_04.orig/lib/ExtUtils/Liblist.pm Tue Sep 9 17:41:32 1997 +--- perl5.004_04/lib/ExtUtils/Liblist.pm Sun Nov 12 21:51:33 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 189,195 **** + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +--- 189,195 ---- + return ("", "", "", "") unless $potential_libs; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my($libpth) = $Config{'libpth'}; + my($libext) = $Config{'lib_ext'} || ".lib"; + +*************** +*** 539,545 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 539,545 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.004_04.orig/lib/ExtUtils/MM_Unix.pm perl5.004_04/lib/ExtUtils/MM_Unix.pm +*** perl5.004_04.orig/lib/ExtUtils/MM_Unix.pm Wed Oct 8 14:13:51 1997 +--- perl5.004_04/lib/ExtUtils/MM_Unix.pm Sun Nov 12 21:50:51 2000 +*************** +*** 2229,2235 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2229,2235 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.004_04.orig/myconfig perl5.004_04/myconfig +*** perl5.004_04.orig/myconfig Mon Oct 6 18:26:49 1997 +--- perl5.004_04/myconfig Sun Nov 12 21:50:51 2000 +*************** +*** 35,41 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +--- 35,41 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +diff -rc perl5.004_04.orig/patchlevel.h perl5.004_04/patchlevel.h +*** perl5.004_04.orig/patchlevel.h Wed Oct 15 10:55:19 1997 +--- perl5.004_04/patchlevel.h Sun Nov 12 21:50:51 2000 +*************** +*** 39,44 **** +--- 39,45 ---- + /* The following line and terminating '};' are read by perlbug.PL. Don't alter. */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.004_05 b/storage/bdb/perl/BerkeleyDB/patches/5.004_05 new file mode 100644 index 00000000000..51c8bf35009 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.004_05 @@ -0,0 +1,209 @@ +diff -rc perl5.004_05.orig/Configure perl5.004_05/Configure +*** perl5.004_05.orig/Configure Thu Jan 6 22:05:49 2000 +--- perl5.004_05/Configure Sun Nov 12 21:36:25 2000 +*************** +*** 188,193 **** +--- 188,194 ---- + mv='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 10164,10169 **** +--- 10165,10178 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 10648,10653 **** +--- 10657,10663 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.004_05.orig/Makefile.SH perl5.004_05/Makefile.SH +*** perl5.004_05.orig/Makefile.SH Thu Jan 6 22:05:49 2000 +--- perl5.004_05/Makefile.SH Sun Nov 12 21:36:25 2000 +*************** +*** 151,157 **** + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 151,157 ---- + ext = \$(dynamic_ext) \$(static_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.004_05.orig/lib/ExtUtils/Embed.pm perl5.004_05/lib/ExtUtils/Embed.pm +*** perl5.004_05.orig/lib/ExtUtils/Embed.pm Fri Aug 1 15:08:44 1997 +--- perl5.004_05/lib/ExtUtils/Embed.pm Sun Nov 12 21:36:25 2000 +*************** +*** 178,184 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 178,184 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.004_05.orig/lib/ExtUtils/Liblist.pm perl5.004_05/lib/ExtUtils/Liblist.pm +*** perl5.004_05.orig/lib/ExtUtils/Liblist.pm Thu Jan 6 22:05:54 2000 +--- perl5.004_05/lib/ExtUtils/Liblist.pm Sun Nov 12 21:45:31 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 196,202 **** + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'libs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +--- 196,202 ---- + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'perllibs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +*************** +*** 590,596 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 590,596 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.004_05.orig/lib/ExtUtils/MM_Unix.pm perl5.004_05/lib/ExtUtils/MM_Unix.pm +*** perl5.004_05.orig/lib/ExtUtils/MM_Unix.pm Thu Jan 6 22:05:54 2000 +--- perl5.004_05/lib/ExtUtils/MM_Unix.pm Sun Nov 12 21:36:25 2000 +*************** +*** 2246,2252 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2246,2252 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.004_05.orig/myconfig perl5.004_05/myconfig +*** perl5.004_05.orig/myconfig Thu Jan 6 22:05:55 2000 +--- perl5.004_05/myconfig Sun Nov 12 21:43:54 2000 +*************** +*** 34,40 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +--- 34,40 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so + useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: +diff -rc perl5.004_05.orig/patchlevel.h perl5.004_05/patchlevel.h +*** perl5.004_05.orig/patchlevel.h Thu Jan 6 22:05:48 2000 +--- perl5.004_05/patchlevel.h Sun Nov 12 21:36:25 2000 +*************** +*** 39,44 **** +--- 39,45 ---- + /* The following line and terminating '};' are read by perlbug.PL. Don't alter. */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.005 b/storage/bdb/perl/BerkeleyDB/patches/5.005 new file mode 100644 index 00000000000..effee3e8275 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.005 @@ -0,0 +1,209 @@ +diff -rc perl5.005.orig/Configure perl5.005/Configure +*** perl5.005.orig/Configure Wed Jul 15 08:05:44 1998 +--- perl5.005/Configure Sun Nov 12 21:30:40 2000 +*************** +*** 234,239 **** +--- 234,240 ---- + nm='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 11279,11284 **** +--- 11280,11293 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 11804,11809 **** +--- 11813,11819 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.005.orig/Makefile.SH perl5.005/Makefile.SH +*** perl5.005.orig/Makefile.SH Sun Jul 19 08:06:35 1998 +--- perl5.005/Makefile.SH Sun Nov 12 21:30:40 2000 +*************** +*** 150,156 **** + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 150,156 ---- + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.005.orig/lib/ExtUtils/Embed.pm perl5.005/lib/ExtUtils/Embed.pm +*** perl5.005.orig/lib/ExtUtils/Embed.pm Wed Jul 22 07:45:02 1998 +--- perl5.005/lib/ExtUtils/Embed.pm Sun Nov 12 21:30:40 2000 +*************** +*** 194,200 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 194,200 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.005.orig/lib/ExtUtils/Liblist.pm perl5.005/lib/ExtUtils/Liblist.pm +*** perl5.005.orig/lib/ExtUtils/Liblist.pm Wed Jul 22 07:09:42 1998 +--- perl5.005/lib/ExtUtils/Liblist.pm Sun Nov 12 21:30:40 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 290,296 **** + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +--- 290,296 ---- + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +*************** +*** 598,604 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 598,604 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.005.orig/lib/ExtUtils/MM_Unix.pm perl5.005/lib/ExtUtils/MM_Unix.pm +*** perl5.005.orig/lib/ExtUtils/MM_Unix.pm Tue Jul 14 04:39:12 1998 +--- perl5.005/lib/ExtUtils/MM_Unix.pm Sun Nov 12 21:30:41 2000 +*************** +*** 2281,2287 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2281,2287 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.005.orig/myconfig perl5.005/myconfig +*** perl5.005.orig/myconfig Fri Apr 3 01:20:35 1998 +--- perl5.005/myconfig Sun Nov 12 21:30:41 2000 +*************** +*** 34,40 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +--- 34,40 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +diff -rc perl5.005.orig/patchlevel.h perl5.005/patchlevel.h +*** perl5.005.orig/patchlevel.h Wed Jul 22 19:22:01 1998 +--- perl5.005/patchlevel.h Sun Nov 12 21:30:41 2000 +*************** +*** 39,44 **** +--- 39,45 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.005_01 b/storage/bdb/perl/BerkeleyDB/patches/5.005_01 new file mode 100644 index 00000000000..2a05dd545f6 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.005_01 @@ -0,0 +1,209 @@ +diff -rc perl5.005_01.orig/Configure perl5.005_01/Configure +*** perl5.005_01.orig/Configure Wed Jul 15 08:05:44 1998 +--- perl5.005_01/Configure Sun Nov 12 20:55:58 2000 +*************** +*** 234,239 **** +--- 234,240 ---- + nm='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 11279,11284 **** +--- 11280,11293 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 11804,11809 **** +--- 11813,11819 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.005_01.orig/Makefile.SH perl5.005_01/Makefile.SH +*** perl5.005_01.orig/Makefile.SH Sun Jul 19 08:06:35 1998 +--- perl5.005_01/Makefile.SH Sun Nov 12 20:55:58 2000 +*************** +*** 150,156 **** + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 150,156 ---- + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.005_01.orig/lib/ExtUtils/Embed.pm perl5.005_01/lib/ExtUtils/Embed.pm +*** perl5.005_01.orig/lib/ExtUtils/Embed.pm Wed Jul 22 07:45:02 1998 +--- perl5.005_01/lib/ExtUtils/Embed.pm Sun Nov 12 20:55:58 2000 +*************** +*** 194,200 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 194,200 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.005_01.orig/lib/ExtUtils/Liblist.pm perl5.005_01/lib/ExtUtils/Liblist.pm +*** perl5.005_01.orig/lib/ExtUtils/Liblist.pm Wed Jul 22 07:09:42 1998 +--- perl5.005_01/lib/ExtUtils/Liblist.pm Sun Nov 12 20:55:58 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 290,296 **** + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +--- 290,296 ---- + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +*************** +*** 598,604 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 598,604 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +diff -rc perl5.005_01.orig/lib/ExtUtils/MM_Unix.pm perl5.005_01/lib/ExtUtils/MM_Unix.pm +*** perl5.005_01.orig/lib/ExtUtils/MM_Unix.pm Tue Jul 14 04:39:12 1998 +--- perl5.005_01/lib/ExtUtils/MM_Unix.pm Sun Nov 12 20:55:58 2000 +*************** +*** 2281,2287 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2281,2287 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -rc perl5.005_01.orig/myconfig perl5.005_01/myconfig +*** perl5.005_01.orig/myconfig Fri Apr 3 01:20:35 1998 +--- perl5.005_01/myconfig Sun Nov 12 20:55:58 2000 +*************** +*** 34,40 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +--- 34,40 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +diff -rc perl5.005_01.orig/patchlevel.h perl5.005_01/patchlevel.h +*** perl5.005_01.orig/patchlevel.h Mon Jan 3 11:07:45 2000 +--- perl5.005_01/patchlevel.h Sun Nov 12 20:55:58 2000 +*************** +*** 39,44 **** +--- 39,45 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.005_02 b/storage/bdb/perl/BerkeleyDB/patches/5.005_02 new file mode 100644 index 00000000000..5dd57ddc03f --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.005_02 @@ -0,0 +1,264 @@ +diff -rc perl5.005_02.orig/Configure perl5.005_02/Configure +*** perl5.005_02.orig/Configure Mon Jan 3 11:12:20 2000 +--- perl5.005_02/Configure Sun Nov 12 20:50:51 2000 +*************** +*** 234,239 **** +--- 234,240 ---- + nm='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 11334,11339 **** +--- 11335,11348 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 11859,11864 **** +--- 11868,11874 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +Only in perl5.005_02: Configure.orig +diff -rc perl5.005_02.orig/Makefile.SH perl5.005_02/Makefile.SH +*** perl5.005_02.orig/Makefile.SH Sun Jul 19 08:06:35 1998 +--- perl5.005_02/Makefile.SH Sun Nov 12 20:50:51 2000 +*************** +*** 150,156 **** + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 150,156 ---- + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +Only in perl5.005_02: Makefile.SH.orig +diff -rc perl5.005_02.orig/lib/ExtUtils/Embed.pm perl5.005_02/lib/ExtUtils/Embed.pm +*** perl5.005_02.orig/lib/ExtUtils/Embed.pm Wed Jul 22 07:45:02 1998 +--- perl5.005_02/lib/ExtUtils/Embed.pm Sun Nov 12 20:50:51 2000 +*************** +*** 194,200 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 194,200 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.005_02.orig/lib/ExtUtils/Liblist.pm perl5.005_02/lib/ExtUtils/Liblist.pm +*** perl5.005_02.orig/lib/ExtUtils/Liblist.pm Mon Jan 3 11:12:21 2000 +--- perl5.005_02/lib/ExtUtils/Liblist.pm Sun Nov 12 20:50:51 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 196,202 **** + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'libs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +--- 196,202 ---- + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'perllibs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +*************** +*** 333,339 **** + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +--- 333,339 ---- + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +*************** +*** 623,629 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +--- 623,629 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs> + as well as in C<$Config{libpth}>. For each library that is found, a +*************** +*** 666,672 **** + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{libs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +--- 666,672 ---- + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{perllibs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +*************** +*** 676,682 **** + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{libs}>. + + =item * + +--- 676,682 ---- + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{perllibs}>. + + =item * + +Only in perl5.005_02/lib/ExtUtils: Liblist.pm.orig +diff -rc perl5.005_02.orig/lib/ExtUtils/MM_Unix.pm perl5.005_02/lib/ExtUtils/MM_Unix.pm +*** perl5.005_02.orig/lib/ExtUtils/MM_Unix.pm Tue Jul 14 04:39:12 1998 +--- perl5.005_02/lib/ExtUtils/MM_Unix.pm Sun Nov 12 20:50:51 2000 +*************** +*** 2281,2287 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2281,2287 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +Only in perl5.005_02/lib/ExtUtils: MM_Unix.pm.orig +diff -rc perl5.005_02.orig/myconfig perl5.005_02/myconfig +*** perl5.005_02.orig/myconfig Fri Apr 3 01:20:35 1998 +--- perl5.005_02/myconfig Sun Nov 12 20:50:51 2000 +*************** +*** 34,40 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +--- 34,40 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +diff -rc perl5.005_02.orig/patchlevel.h perl5.005_02/patchlevel.h +*** perl5.005_02.orig/patchlevel.h Mon Jan 3 11:12:19 2000 +--- perl5.005_02/patchlevel.h Sun Nov 12 20:50:51 2000 +*************** +*** 40,45 **** +--- 40,46 ---- + */ + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.005_03 b/storage/bdb/perl/BerkeleyDB/patches/5.005_03 new file mode 100644 index 00000000000..115f9f5b909 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.005_03 @@ -0,0 +1,250 @@ +diff -rc perl5.005_03.orig/Configure perl5.005_03/Configure +*** perl5.005_03.orig/Configure Sun Mar 28 17:12:57 1999 +--- perl5.005_03/Configure Sun Sep 17 22:19:16 2000 +*************** +*** 208,213 **** +--- 208,214 ---- + nm='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 11642,11647 **** +--- 11643,11656 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 12183,12188 **** +--- 12192,12198 ---- + patchlevel='$patchlevel' + path_sep='$path_sep' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -rc perl5.005_03.orig/Makefile.SH perl5.005_03/Makefile.SH +*** perl5.005_03.orig/Makefile.SH Thu Mar 4 02:35:25 1999 +--- perl5.005_03/Makefile.SH Sun Sep 17 22:21:01 2000 +*************** +*** 58,67 **** + shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" + case "$osvers" in + 3*) +! shrpldflags="$shrpldflags -e _nostart $ldflags $libs $cryptlib" + ;; + *) +! shrpldflags="$shrpldflags -b noentry $ldflags $libs $cryptlib" + ;; + esac + aixinstdir=`pwd | sed 's/\/UU$//'` +--- 58,67 ---- + shrpldflags="-H512 -T512 -bhalt:4 -bM:SRE -bE:perl.exp" + case "$osvers" in + 3*) +! shrpldflags="$shrpldflags -e _nostart $ldflags $perllibs $cryptlib" + ;; + *) +! shrpldflags="$shrpldflags -b noentry $ldflags $perllibs $cryptlib" + ;; + esac + aixinstdir=`pwd | sed 's/\/UU$//'` +*************** +*** 155,161 **** + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 155,161 ---- + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +diff -rc perl5.005_03.orig/lib/ExtUtils/Embed.pm perl5.005_03/lib/ExtUtils/Embed.pm +*** perl5.005_03.orig/lib/ExtUtils/Embed.pm Wed Jan 6 02:17:50 1999 +--- perl5.005_03/lib/ExtUtils/Embed.pm Sun Sep 17 22:19:16 2000 +*************** +*** 194,200 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 194,200 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -rc perl5.005_03.orig/lib/ExtUtils/Liblist.pm perl5.005_03/lib/ExtUtils/Liblist.pm +*** perl5.005_03.orig/lib/ExtUtils/Liblist.pm Wed Jan 6 02:17:47 1999 +--- perl5.005_03/lib/ExtUtils/Liblist.pm Sun Sep 17 22:19:16 2000 +*************** +*** 16,33 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 16,33 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 196,202 **** + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'libs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +--- 196,202 ---- + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'perllibs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +*************** +*** 336,342 **** + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +--- 336,342 ---- + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +*************** +*** 626,632 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs>, + C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +--- 626,632 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs>, + C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +*************** +*** 670,676 **** + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{libs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +--- 670,676 ---- + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{perllibs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +*************** +*** 680,686 **** + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{libs}>. + + =item * + +--- 680,686 ---- + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{perllibs}>. + + =item * + +diff -rc perl5.005_03.orig/lib/ExtUtils/MM_Unix.pm perl5.005_03/lib/ExtUtils/MM_Unix.pm +*** perl5.005_03.orig/lib/ExtUtils/MM_Unix.pm Fri Mar 5 00:34:20 1999 +--- perl5.005_03/lib/ExtUtils/MM_Unix.pm Sun Sep 17 22:19:16 2000 +*************** +*** 2284,2290 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2284,2290 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { diff --git a/storage/bdb/perl/BerkeleyDB/patches/5.6.0 b/storage/bdb/perl/BerkeleyDB/patches/5.6.0 new file mode 100644 index 00000000000..1f9b3b620de --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/patches/5.6.0 @@ -0,0 +1,294 @@ +diff -cr perl-5.6.0.orig/Configure perl-5.6.0/Configure +*** perl-5.6.0.orig/Configure Wed Mar 22 20:36:37 2000 +--- perl-5.6.0/Configure Sun Sep 17 23:40:15 2000 +*************** +*** 217,222 **** +--- 217,223 ---- + nm='' + nroff='' + perl='' ++ perllibs='' + pg='' + pmake='' + pr='' +*************** +*** 14971,14976 **** +--- 14972,14985 ---- + shift + extensions="$*" + ++ : Remove libraries needed only for extensions ++ : The appropriate ext/Foo/Makefile.PL will add them back in, if ++ : necessary. ++ set X `echo " $libs " | ++ sed -e 's@ -lndbm @ @' -e 's@ -lgdbm @ @' -e 's@ -ldbm @ @' -e 's@ -ldb @ @'` ++ shift ++ perllibs="$*" ++ + : Remove build directory name from cppstdin so it can be used from + : either the present location or the final installed location. + echo " " +*************** +*** 15640,15645 **** +--- 15649,15655 ---- + path_sep='$path_sep' + perl5='$perl5' + perl='$perl' ++ perllibs='$perllibs' + perladmin='$perladmin' + perlpath='$perlpath' + pg='$pg' +diff -cr perl-5.6.0.orig/Makefile.SH perl-5.6.0/Makefile.SH +*** perl-5.6.0.orig/Makefile.SH Sat Mar 11 16:05:24 2000 +--- perl-5.6.0/Makefile.SH Sun Sep 17 23:40:15 2000 +*************** +*** 70,76 **** + *) shrpldflags="$shrpldflags -b noentry" + ;; + esac +! shrpldflags="$shrpldflags $ldflags $libs $cryptlib" + linklibperl="-L $archlibexp/CORE -L `pwd | sed 's/\/UU$//'` -lperl" + ;; + hpux*) +--- 70,76 ---- + *) shrpldflags="$shrpldflags -b noentry" + ;; + esac +! shrpldflags="$shrpldflags $ldflags $perllibs $cryptlib" + linklibperl="-L $archlibexp/CORE -L `pwd | sed 's/\/UU$//'` -lperl" + ;; + hpux*) +*************** +*** 176,182 **** + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $libs $cryptlib + + public = perl $suidperl utilities translators + +--- 176,182 ---- + ext = \$(dynamic_ext) \$(static_ext) \$(nonxs_ext) + DYNALOADER = lib/auto/DynaLoader/DynaLoader\$(LIB_EXT) + +! libs = $perllibs $cryptlib + + public = perl $suidperl utilities translators + +*************** +*** 333,339 **** + case "$osname" in + aix) + $spitshell >>Makefile <<!GROK!THIS! +! LIBS = $libs + # In AIX we need to change this for building Perl itself from + # its earlier definition (which is for building external + # extensions *after* Perl has been built and installed) +--- 333,339 ---- + case "$osname" in + aix) + $spitshell >>Makefile <<!GROK!THIS! +! LIBS = $perllibs + # In AIX we need to change this for building Perl itself from + # its earlier definition (which is for building external + # extensions *after* Perl has been built and installed) +diff -cr perl-5.6.0.orig/lib/ExtUtils/Embed.pm perl-5.6.0/lib/ExtUtils/Embed.pm +*** perl-5.6.0.orig/lib/ExtUtils/Embed.pm Sun Jan 23 12:08:32 2000 +--- perl-5.6.0/lib/ExtUtils/Embed.pm Sun Sep 17 23:40:15 2000 +*************** +*** 193,199 **** + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{libs}) if defined $std; + + push(@mods, static_ext()) if $std; + +--- 193,199 ---- + @path = $path ? split(/:/, $path) : @INC; + + push(@potential_libs, @link_args) if scalar @link_args; +! push(@potential_libs, $Config{perllibs}) if defined $std; + + push(@mods, static_ext()) if $std; + +diff -cr perl-5.6.0.orig/lib/ExtUtils/Liblist.pm perl-5.6.0/lib/ExtUtils/Liblist.pm +*** perl-5.6.0.orig/lib/ExtUtils/Liblist.pm Wed Mar 22 16:16:31 2000 +--- perl-5.6.0/lib/ExtUtils/Liblist.pm Sun Sep 17 23:40:15 2000 +*************** +*** 17,34 **** + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{libs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{libs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'libs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +--- 17,34 ---- + + sub _unix_os2_ext { + my($self,$potential_libs, $verbose) = @_; +! if ($^O =~ 'os2' and $Config{perllibs}) { + # Dynamic libraries are not transitive, so we may need including + # the libraries linked against perl.dll again. + + $potential_libs .= " " if $potential_libs; +! $potential_libs .= $Config{perllibs}; + } + return ("", "", "", "") unless $potential_libs; + warn "Potential libraries are '$potential_libs':\n" if $verbose; + + my($so) = $Config{'so'}; +! my($libs) = $Config{'perllibs'}; + my $Config_libext = $Config{lib_ext} || ".a"; + + +*************** +*** 198,204 **** + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'libs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +--- 198,204 ---- + my $BC = 1 if $cc =~ /^bcc/i; + my $GC = 1 if $cc =~ /^gcc/i; + my $so = $Config{'so'}; +! my $libs = $Config{'perllibs'}; + my $libpth = $Config{'libpth'}; + my $libext = $Config{'lib_ext'} || ".lib"; + +*************** +*** 338,344 **** + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +--- 338,344 ---- + $self->{CCFLAS} || $Config{'ccflags'}; + @crtls = ( ($dbgqual =~ m-/Debug-i ? $Config{'dbgprefix'} : '') + . 'PerlShr/Share' ); +! push(@crtls, grep { not /\(/ } split /\s+/, $Config{'perllibs'}); + push(@crtls, grep { not /\(/ } split /\s+/, $Config{'libc'}); + # In general, we pass through the basic libraries from %Config unchanged. + # The one exception is that if we're building in the Perl source tree, and +*************** +*** 624,630 **** + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{libs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs>, + C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +--- 624,630 ---- + =item * + + If C<$potential_libs> is empty, the return value will be empty. +! Otherwise, the libraries specified by C<$Config{perllibs}> (see Config.pm) + will be appended to the list of C<$potential_libs>. The libraries + will be searched for in the directories specified in C<$potential_libs>, + C<$Config{libpth}>, and in C<$Config{installarchlib}/CORE>. +*************** +*** 668,674 **** + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{libs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +--- 668,674 ---- + alphanumeric characters are treated as flags. Unknown flags will be ignored. + + An entry that matches C</:nodefault/i> disables the appending of default +! libraries found in C<$Config{perllibs}> (this should be only needed very rarely). + + An entry that matches C</:nosearch/i> disables all searching for + the libraries specified after it. Translation of C<-Lfoo> and +*************** +*** 678,684 **** + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{libs}>. + + =item * + +--- 678,684 ---- + + An entry that matches C</:search/i> reenables searching for + the libraries specified after it. You can put it at the end to +! enable searching for default libraries specified by C<$Config{perllibs}>. + + =item * + +diff -cr perl-5.6.0.orig/lib/ExtUtils/MM_Unix.pm perl-5.6.0/lib/ExtUtils/MM_Unix.pm +*** perl-5.6.0.orig/lib/ExtUtils/MM_Unix.pm Thu Mar 2 17:52:52 2000 +--- perl-5.6.0/lib/ExtUtils/MM_Unix.pm Sun Sep 17 23:40:15 2000 +*************** +*** 2450,2456 **** + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{libs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +--- 2450,2456 ---- + MAP_STATIC = ", + join(" \\\n\t", reverse sort keys %static), " + +! MAP_PRELIBS = $Config::Config{perllibs} $Config::Config{cryptlib} + "; + + if (defined $libperl) { +diff -cr perl-5.6.0.orig/myconfig.SH perl-5.6.0/myconfig.SH +*** perl-5.6.0.orig/myconfig.SH Sat Feb 26 06:34:49 2000 +--- perl-5.6.0/myconfig.SH Sun Sep 17 23:41:17 2000 +*************** +*** 48,54 **** + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$libs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +--- 48,54 ---- + Linker and Libraries: + ld='$ld', ldflags ='$ldflags' + libpth=$libpth +! libs=$perllibs + libc=$libc, so=$so, useshrplib=$useshrplib, libperl=$libperl + Dynamic Linking: + dlsrc=$dlsrc, dlext=$dlext, d_dlsymun=$d_dlsymun, ccdlflags='$ccdlflags' +diff -cr perl-5.6.0.orig/patchlevel.h perl-5.6.0/patchlevel.h +*** perl-5.6.0.orig/patchlevel.h Wed Mar 22 20:23:11 2000 +--- perl-5.6.0/patchlevel.h Sun Sep 17 23:40:15 2000 +*************** +*** 70,75 **** +--- 70,76 ---- + #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) + static char *local_patches[] = { + NULL ++ ,"NODB-1.0 - remove -ldb from core perl binary." + ,NULL + }; + diff --git a/storage/bdb/perl/BerkeleyDB/ppport.h b/storage/bdb/perl/BerkeleyDB/ppport.h new file mode 100644 index 00000000000..0887c2159a9 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/ppport.h @@ -0,0 +1,329 @@ +/* This file is Based on output from + * Perl/Pollution/Portability Version 2.0000 */ + +#ifndef _P_P_PORTABILITY_H_ +#define _P_P_PORTABILITY_H_ + +#ifndef PERL_REVISION +# ifndef __PATCHLEVEL_H_INCLUDED__ +# include "patchlevel.h" +# endif +# ifndef PERL_REVISION +# define PERL_REVISION (5) + /* Replace: 1 */ +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ + /* Replace: 0 */ +# endif +#endif + +#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) + +#ifndef ERRSV +# define ERRSV perl_get_sv("@",FALSE) +#endif + +#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5)) +/* Replace: 1 */ +# define PL_Sv Sv +# define PL_compiling compiling +# define PL_copline copline +# define PL_curcop curcop +# define PL_curstash curstash +# define PL_defgv defgv +# define PL_dirty dirty +# define PL_hints hints +# define PL_na na +# define PL_perldb perldb +# define PL_rsfp_filters rsfp_filters +# define PL_rsfp rsfp +# define PL_stdingv stdingv +# define PL_sv_no sv_no +# define PL_sv_undef sv_undef +# define PL_sv_yes sv_yes +/* Replace: 0 */ +#endif + +#ifndef pTHX +# define pTHX +# define pTHX_ +# define aTHX +# define aTHX_ +#endif + +#ifndef PTR2IV +# define PTR2IV(d) (IV)(d) +#endif + +#ifndef INT2PTR +# define INT2PTR(any,d) (any)(d) +#endif + +#ifndef dTHR +# ifdef WIN32 +# define dTHR extern int Perl___notused +# else +# define dTHR extern int errno +# endif +#endif + +#ifndef boolSV +# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#endif + +#ifndef gv_stashpvn +# define gv_stashpvn(str,len,flags) gv_stashpv(str,flags) +#endif + +#ifndef newSVpvn +# define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0)) +#endif + +#ifndef newRV_inc +/* Replace: 1 */ +# define newRV_inc(sv) newRV(sv) +/* Replace: 0 */ +#endif + +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +# define DEFSV GvSV(PL_defgv) +#endif + +#ifndef SAVE_DEFSV +# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +#endif + +#ifndef newRV_noinc +# ifdef __GNUC__ +# define newRV_noinc(sv) \ + ({ \ + SV *nsv = (SV*)newRV(sv); \ + SvREFCNT_dec(sv); \ + nsv; \ + }) +# else +# if defined(CRIPPLED_CC) || defined(USE_THREADS) +static SV * newRV_noinc (SV * sv) +{ + SV *nsv = (SV*)newRV(sv); + SvREFCNT_dec(sv); + return nsv; +} +# else +# define newRV_noinc(sv) \ + ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv) +# endif +# endif +#endif + +/* Provide: newCONSTSUB */ + +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ +#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63)) + +#if defined(NEED_newCONSTSUB) +static +#else +extern void newCONSTSUB _((HV * stash, char * name, SV *sv)); +#endif + +#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL) +void +newCONSTSUB(stash,name,sv) +HV *stash; +char *name; +SV *sv; +{ + U32 oldhints = PL_hints; + HV *old_cop_stash = PL_curcop->cop_stash; + HV *old_curstash = PL_curstash; + line_t oldline = PL_curcop->cop_line; + PL_curcop->cop_line = PL_copline; + + PL_hints &= ~HINT_BLOCK_SCOPE; + if (stash) + PL_curstash = PL_curcop->cop_stash = stash; + + newSUB( + +#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)) + /* before 5.003_22 */ + start_subparse(), +#else +# if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22) + /* 5.003_22 */ + start_subparse(0), +# else + /* 5.003_23 onwards */ + start_subparse(FALSE, 0), +# endif +#endif + + newSVOP(OP_CONST, 0, newSVpv(name,0)), + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) + ); + + PL_hints = oldhints; + PL_curcop->cop_stash = old_cop_stash; + PL_curstash = old_curstash; + PL_curcop->cop_line = oldline; +} +#endif + +#endif /* newCONSTSUB */ + + +#ifndef START_MY_CXT + +/* + * Boilerplate macros for initializing and accessing interpreter-local + * data from C. All statics in extensions should be reworked to use + * this, if you want to make the extension thread-safe. See ext/re/re.xs + * for an example of the use of these macros. + * + * Code that uses these macros is responsible for the following: + * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" + * 2. Declare a typedef named my_cxt_t that is a structure that contains + * all the data that needs to be interpreter-local. + * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. + * 4. Use the MY_CXT_INIT macro such that it is called exactly once + * (typically put in the BOOT: section). + * 5. Use the members of the my_cxt_t structure everywhere as + * MY_CXT.member. + * 6. Use the dMY_CXT macro (a declaration) in all the functions that + * access MY_CXT. + */ + +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ + defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) + +/* This must appear in all extensions that define a my_cxt_t structure, + * right after the definition (i.e. at file scope). The non-threads + * case below uses it to declare the data as static. */ +#define START_MY_CXT + +#if PERL_REVISION == 5 && \ + (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 )) +/* Fetches the SV that keeps the per-interpreter data. */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE) +#else /* >= perl5.004_68 */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ + sizeof(MY_CXT_KEY)-1, TRUE) +#endif /* < perl5.004_68 */ + +/* This declaration should be used within all functions that use the + * interpreter-local data. */ +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) + +/* Creates and zeroes the per-interpreter data. + * (We allocate my_cxtp in a Perl SV so that it will be released when + * the interpreter goes away.) */ +#define MY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Zero(my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + +/* This macro must be used to access members of the my_cxt_t structure. + * e.g. MYCXT.some_data */ +#define MY_CXT (*my_cxtp) + +/* Judicious use of these macros can reduce the number of times dMY_CXT + * is used. Use is similar to pTHX, aTHX etc. */ +#define pMY_CXT my_cxt_t *my_cxtp +#define pMY_CXT_ pMY_CXT, +#define _pMY_CXT ,pMY_CXT +#define aMY_CXT my_cxtp +#define aMY_CXT_ aMY_CXT, +#define _aMY_CXT ,aMY_CXT + +#else /* single interpreter */ + +#ifndef NOOP +# define NOOP (void)0 +#endif + +#ifdef HASATTRIBUTE +# define PERL_UNUSED_DECL __attribute__((unused)) +#else +# define PERL_UNUSED_DECL +#endif + +#ifndef dNOOP +# define dNOOP extern int Perl___notused PERL_UNUSED_DECL +#endif + +#define START_MY_CXT static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT dNOOP +#define MY_CXT_INIT NOOP +#define MY_CXT my_cxt + +#define pMY_CXT void +#define pMY_CXT_ +#define _pMY_CXT +#define aMY_CXT +#define aMY_CXT_ +#define _aMY_CXT + +#endif + +#endif /* START_MY_CXT */ + + +#ifndef DBM_setFilter + +/* + The DBM_setFilter & DBM_ckFilter macros are only used by + the *DB*_File modules +*/ + +#define DBM_setFilter(db_type,code) \ + { \ + if (db_type) \ + RETVAL = sv_mortalcopy(db_type) ; \ + ST(0) = RETVAL ; \ + if (db_type && (code == &PL_sv_undef)) { \ + SvREFCNT_dec(db_type) ; \ + db_type = NULL ; \ + } \ + else if (code) { \ + if (db_type) \ + sv_setsv(db_type, code) ; \ + else \ + db_type = newSVsv(code) ; \ + } \ + } + +#define DBM_ckFilter(arg,type,name) \ + if (db->type) { \ + if (db->filtering) { \ + croak("recursion detected in %s", name) ; \ + } \ + ENTER ; \ + SAVETMPS ; \ + SAVEINT(db->filtering) ; \ + db->filtering = TRUE ; \ + SAVESPTR(DEFSV) ; \ + DEFSV = arg ; \ + SvTEMP_off(arg) ; \ + PUSHMARK(SP) ; \ + PUTBACK ; \ + (void) perl_call_sv(db->type, G_DISCARD); \ + SPAGAIN ; \ + PUTBACK ; \ + FREETMPS ; \ + LEAVE ; \ + } + +#endif /* DBM_setFilter */ + +#endif /* _P_P_PORTABILITY_H_ */ diff --git a/storage/bdb/perl/BerkeleyDB/scan b/storage/bdb/perl/BerkeleyDB/scan new file mode 100644 index 00000000000..eb064950b2e --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/scan @@ -0,0 +1,229 @@ +#!/usr/local/bin/perl + +my $ignore_re = '^(' . join("|", + qw( + _ + [a-z] + DBM + DBC + DB_AM_ + DB_BT_ + DB_RE_ + DB_HS_ + DB_FUNC_ + DB_DBT_ + DB_DBM + DB_TSL + MP + TXN + )) . ')' ; + +my %ignore_def = map {$_, 1} qw() ; + +%ignore_enums = map {$_, 1} qw( ACTION db_status_t db_notices db_lockmode_t ) ; + +my $filler = ' ' x 26 ; + +chdir "libraries" || die "Cannot chdir into './libraries': $!\n"; + +foreach my $name (sort tuple glob "[2-9]*") +{ + my $inc = "$name/include/db.h" ; + next unless -f $inc ; + + my $file = readFile($inc) ; + StripCommentsAndStrings($file) ; + my $result = scan($name, $file) ; + print "\n\t#########\n\t# $name\n\t#########\n\n$result" + if $result; +} +exit ; + + +sub scan +{ + my $version = shift ; + my $file = shift ; + + my %seen_define = () ; + my $result = "" ; + + if (1) { + # Preprocess all tri-graphs + # including things stuck in quoted string constants. + $file =~ s/\?\?=/#/g; # | ??=| #| + $file =~ s/\?\?\!/|/g; # | ??!| || + $file =~ s/\?\?'/^/g; # | ??'| ^| + $file =~ s/\?\?\(/[/g; # | ??(| [| + $file =~ s/\?\?\)/]/g; # | ??)| ]| + $file =~ s/\?\?\-/~/g; # | ??-| ~| + $file =~ s/\?\?\//\\/g; # | ??/| \| + $file =~ s/\?\?</{/g; # | ??<| {| + $file =~ s/\?\?>/}/g; # | ??>| }| + } + + while ( $file =~ /^\s*#\s*define\s+([\$\w]+)\b(?!\()\s*(.*)/gm ) + { + my $def = $1; + my $rest = $2; + my $ignore = 0 ; + + $ignore = 1 if $ignore_def{$def} || $def =~ /$ignore_re/o ; + + # Cannot do: (-1) and ((LHANDLE)3) are OK: + #print("Skip non-wordy $def => $rest\n"), + + $rest =~ s/\s*$//; + #next if $rest =~ /[^\w\$]/; + + #print "Matched $_ ($def)\n" ; + + next if $before{$def} ++ ; + + if ($ignore) + { $seen_define{$def} = 'IGNORE' } + elsif ($rest =~ /"/) + { $seen_define{$def} = 'STRING' } + else + { $seen_define{$def} = 'DEFINE' } + } + + foreach $define (sort keys %seen_define) + { + my $out = $filler ; + substr($out,0, length $define) = $define; + $result .= "\t$out => $seen_define{$define},\n" ; + } + + while ($file =~ /\btypedef\s+enum\s*{(.*?)}\s*(\w+)/gs ) + { + my $enum = $1 ; + my $name = $2 ; + my $ignore = 0 ; + + $ignore = 1 if $ignore_enums{$name} ; + + #$enum =~ s/\s*=\s*\S+\s*(,?)\s*\n/$1/g; + $enum =~ s/^\s*//; + $enum =~ s/\s*$//; + + my @tokens = map { s/\s*=.*// ; $_} split /\s*,\s*/, $enum ; + my @new = grep { ! $Enums{$_}++ } @tokens ; + if (@new) + { + my $value ; + if ($ignore) + { $value = "IGNORE, # $version" } + else + { $value = "'$version'," } + + $result .= "\n\t# enum $name\n"; + my $out = $filler ; + foreach $name (@new) + { + $out = $filler ; + substr($out,0, length $name) = $name; + $result .= "\t$out => $value\n" ; + } + } + } + + return $result ; +} + + +sub StripCommentsAndStrings +{ + + # Strip C & C++ coments + # From the perlfaq + $_[0] =~ + + s{ + /\* ## Start of /* ... */ comment + [^*]*\*+ ## Non-* followed by 1-or-more *'s + ( + [^/*][^*]*\*+ + )* ## 0-or-more things which don't start with / + ## but do end with '*' + / ## End of /* ... */ comment + + | ## OR C++ Comment + // ## Start of C++ comment // + [^\n]* ## followed by 0-or-more non end of line characters + + | ## OR various things which aren't comments: + + ( + " ## Start of " ... " string + ( + \\. ## Escaped char + | ## OR + [^"\\] ## Non "\ + )* + " ## End of " ... " string + + | ## OR + + ' ## Start of ' ... ' string + ( + \\. ## Escaped char + | ## OR + [^'\\] ## Non '\ + )* + ' ## End of ' ... ' string + + | ## OR + + . ## Anything other char + [^/"'\\]* ## Chars which doesn't start a comment, string or escape + ) + }{$2}gxs; + + + + # Remove double-quoted strings. + #$_[0] =~ s#"(\\.|[^"\\])*"##g; + + # Remove single-quoted strings. + #$_[0] =~ s#'(\\.|[^'\\])*'##g; + + # Remove leading whitespace. + $_[0] =~ s/\A\s+//m ; + + # Remove trailing whitespace. + $_[0] =~ s/\s+\Z//m ; + + # Replace all multiple whitespace by a single space. + #$_[0] =~ s/\s+/ /g ; +} + + +sub readFile +{ + my $filename = shift ; + open F, "<$filename" || die "Cannot open $filename: $!\n" ; + local $/ ; + my $x = <F> ; + close F ; + return $x ; +} + +sub tuple +{ + my (@a) = split(/\./, $a) ; + my (@b) = split(/\./, $b) ; + if (@a != @b) { + my $diff = @a - @b ; + push @b, (0 x $diff) if $diff > 0 ; + push @a, (0 x -$diff) if $diff < 0 ; + } + foreach $A (@a) { + $B = shift @b ; + $A == $B or return $A <=> $B ; + } + return 0; +} + +__END__ + diff --git a/storage/bdb/perl/BerkeleyDB/t/btree.t b/storage/bdb/perl/BerkeleyDB/t/btree.t new file mode 100644 index 00000000000..fd6ed8f1268 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/btree.t @@ -0,0 +1,931 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..244\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' $db = new BerkeleyDB::Btree -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $db = new BerkeleyDB::Btree -Bad => 2, -Mode => 0345, -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) (Bad |Stupid ){2}/ ; + + eval ' $db = new BerkeleyDB::Btree -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' $db = new BerkeleyDB::Btree -Txn => "x" ' ; + ok 4, $@ =~ /^Txn not of type BerkeleyDB::Txn/ ; + + my $obj = bless [], "main" ; + eval ' $db = new BerkeleyDB::Btree -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +# Now check the interface to Btree + +{ + my $lex = new LexFile $Dfile ; + + ok 6, my $db = new BerkeleyDB::Btree -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + my $status ; + ok 7, $db->db_put("some key", "some value") == 0 ; + ok 8, $db->status() == 0 ; + ok 9, $db->db_get("some key", $value) == 0 ; + ok 10, $value eq "some value" ; + ok 11, $db->db_put("key", "value") == 0 ; + ok 12, $db->db_get("key", $value) == 0 ; + ok 13, $value eq "value" ; + ok 14, $db->db_del("some key") == 0 ; + ok 15, ($status = $db->db_get("some key", $value)) == DB_NOTFOUND ; + ok 16, $db->status() == DB_NOTFOUND ; + ok 17, $db->status() eq $DB_errors{'DB_NOTFOUND'} ; + + ok 18, $db->db_sync() == 0 ; + + # Check NOOVERWRITE will make put fail when attempting to overwrite + # an existing record. + + ok 19, $db->db_put( 'key', 'x', DB_NOOVERWRITE) == DB_KEYEXIST ; + ok 20, $db->status() eq $DB_errors{'DB_KEYEXIST'} ; + ok 21, $db->status() == DB_KEYEXIST ; + + + # check that the value of the key has not been changed by the + # previous test + ok 22, $db->db_get("key", $value) == 0 ; + ok 23, $value eq "value" ; + + # test DB_GET_BOTH + my ($k, $v) = ("key", "value") ; + ok 24, $db->db_get($k, $v, DB_GET_BOTH) == 0 ; + + ($k, $v) = ("key", "fred") ; + ok 25, $db->db_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + ($k, $v) = ("another", "value") ; + ok 26, $db->db_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + +} + +{ + # Check simple env works with a hash. + my $lex = new LexFile $Dfile ; + + my $home = "./fred" ; + ok 27, my $lexD = new LexDir($home) ; + + ok 28, my $env = new BerkeleyDB::Env -Flags => DB_CREATE|DB_INIT_MPOOL, + -Home => $home ; + ok 29, my $db = new BerkeleyDB::Btree -Filename => $Dfile, + -Env => $env, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + ok 30, $db->db_put("some key", "some value") == 0 ; + ok 31, $db->db_get("some key", $value) == 0 ; + ok 32, $value eq "some value" ; + undef $db ; + undef $env ; +} + + +{ + # cursors + + my $lex = new LexFile $Dfile ; + my %hash ; + my ($k, $v) ; + ok 33, my $db = new BerkeleyDB::Btree -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => 2, + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (($k, $v) = each %data) { + $ret += $db->db_put($k, $v) ; + } + ok 34, $ret == 0 ; + + # create the cursor + ok 35, my $cursor = $db->db_cursor() ; + + $k = $v = "" ; + my %copy = %data ; + my $extras = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 36, $cursor->status() == DB_NOTFOUND ; + ok 37, $cursor->status() eq $DB_errors{'DB_NOTFOUND'}; + ok 38, keys %copy == 0 ; + ok 39, $extras == 0 ; + + # sequence backwards + %copy = %data ; + $extras = 0 ; + my $status ; + for ( $status = $cursor->c_get($k, $v, DB_LAST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_PREV)) { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 40, $status == DB_NOTFOUND ; + ok 41, $status eq $DB_errors{'DB_NOTFOUND'}; + ok 42, $cursor->status() == $status ; + ok 43, $cursor->status() eq $status ; + ok 44, keys %copy == 0 ; + ok 45, $extras == 0 ; + + ($k, $v) = ("green", "house") ; + ok 46, $cursor->c_get($k, $v, DB_GET_BOTH) == 0 ; + + ($k, $v) = ("green", "door") ; + ok 47, $cursor->c_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + ($k, $v) = ("black", "house") ; + ok 48, $cursor->c_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + +} + +{ + # Tied Hash interface + + my $lex = new LexFile $Dfile ; + my %hash ; + ok 49, tie %hash, 'BerkeleyDB::Btree', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # check "each" with an empty database + my $count = 0 ; + while (my ($k, $v) = each %hash) { + ++ $count ; + } + ok 50, (tied %hash)->status() == DB_NOTFOUND ; + ok 51, $count == 0 ; + + # Add a k/v pair + my $value ; + $hash{"some key"} = "some value"; + ok 52, (tied %hash)->status() == 0 ; + ok 53, $hash{"some key"} eq "some value"; + ok 54, defined $hash{"some key"} ; + ok 55, (tied %hash)->status() == 0 ; + ok 56, exists $hash{"some key"} ; + ok 57, !defined $hash{"jimmy"} ; + ok 58, (tied %hash)->status() == DB_NOTFOUND ; + ok 59, !exists $hash{"jimmy"} ; + ok 60, (tied %hash)->status() == DB_NOTFOUND ; + + delete $hash{"some key"} ; + ok 61, (tied %hash)->status() == 0 ; + ok 62, ! defined $hash{"some key"} ; + ok 63, (tied %hash)->status() == DB_NOTFOUND ; + ok 64, ! exists $hash{"some key"} ; + ok 65, (tied %hash)->status() == DB_NOTFOUND ; + + $hash{1} = 2 ; + $hash{10} = 20 ; + $hash{1000} = 2000 ; + + my ($keys, $values) = (0,0); + $count = 0 ; + while (my ($k, $v) = each %hash) { + $keys += $k ; + $values += $v ; + ++ $count ; + } + ok 66, $count == 3 ; + ok 67, $keys == 1011 ; + ok 68, $values == 2022 ; + + # now clear the hash + %hash = () ; + ok 69, keys %hash == 0 ; + + untie %hash ; +} + +{ + # override default compare + my $lex = new LexFile $Dfile, $Dfile2, $Dfile3 ; + my $value ; + my (%h, %g, %k) ; + my @Keys = qw( 0123 12 -1234 9 987654321 def ) ; + ok 70, tie %h, "BerkeleyDB::Btree", -Filename => $Dfile, + -Compare => sub { $_[0] <=> $_[1] }, + -Flags => DB_CREATE ; + + ok 71, tie %g, 'BerkeleyDB::Btree', -Filename => $Dfile2, + -Compare => sub { $_[0] cmp $_[1] }, + -Flags => DB_CREATE ; + + ok 72, tie %k, 'BerkeleyDB::Btree', -Filename => $Dfile3, + -Compare => sub { length $_[0] <=> length $_[1] }, + -Flags => DB_CREATE ; + + my @srt_1 ; + { local $^W = 0 ; + @srt_1 = sort { $a <=> $b } @Keys ; + } + my @srt_2 = sort { $a cmp $b } @Keys ; + my @srt_3 = sort { length $a <=> length $b } @Keys ; + + foreach (@Keys) { + local $^W = 0 ; + $h{$_} = 1 ; + $g{$_} = 1 ; + $k{$_} = 1 ; + } + + sub ArrayCompare + { + my($a, $b) = @_ ; + + return 0 if @$a != @$b ; + + foreach (1 .. length @$a) + { + return 0 unless $$a[$_] eq $$b[$_] ; + } + + 1 ; + } + + ok 73, ArrayCompare (\@srt_1, [keys %h]); + ok 74, ArrayCompare (\@srt_2, [keys %g]); + ok 75, ArrayCompare (\@srt_3, [keys %k]); + +} + +{ + # override default compare, with duplicates, don't sort values + my $lex = new LexFile $Dfile, $Dfile2, $Dfile3 ; + my $value ; + my (%h, %g, %k) ; + my @Keys = qw( 0123 9 12 -1234 9 987654321 def ) ; + my @Values = qw( 1 0 3 dd x abc 0 ) ; + ok 76, tie %h, "BerkeleyDB::Btree", -Filename => $Dfile, + -Compare => sub { $_[0] <=> $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + ok 77, tie %g, 'BerkeleyDB::Btree', -Filename => $Dfile2, + -Compare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + ok 78, tie %k, 'BerkeleyDB::Btree', -Filename => $Dfile3, + -Compare => sub { length $_[0] <=> length $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + my @srt_1 ; + { local $^W = 0 ; + @srt_1 = sort { $a <=> $b } @Keys ; + } + my @srt_2 = sort { $a cmp $b } @Keys ; + my @srt_3 = sort { length $a <=> length $b } @Keys ; + + foreach (@Keys) { + local $^W = 0 ; + my $value = shift @Values ; + $h{$_} = $value ; + $g{$_} = $value ; + $k{$_} = $value ; + } + + sub getValues + { + my $hash = shift ; + my $db = tied %$hash ; + my $cursor = $db->db_cursor() ; + my @values = () ; + my ($k, $v) = (0,0) ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + push @values, $v ; + } + return @values ; + } + + ok 79, ArrayCompare (\@srt_1, [keys %h]); + ok 80, ArrayCompare (\@srt_2, [keys %g]); + ok 81, ArrayCompare (\@srt_3, [keys %k]); + ok 82, ArrayCompare ([qw(dd 0 0 x 3 1 abc)], [getValues \%h]); + ok 83, ArrayCompare ([qw(dd 1 0 3 x abc 0)], [getValues \%g]); + ok 84, ArrayCompare ([qw(0 x 3 0 1 dd abc)], [getValues \%k]); + + # test DB_DUP_NEXT + ok 85, my $cur = (tied %g)->db_cursor() ; + my ($k, $v) = (9, "") ; + ok 86, $cur->c_get($k, $v, DB_SET) == 0 ; + ok 87, $k == 9 && $v == 0 ; + ok 88, $cur->c_get($k, $v, DB_NEXT_DUP) == 0 ; + ok 89, $k == 9 && $v eq "x" ; + ok 90, $cur->c_get($k, $v, DB_NEXT_DUP) == DB_NOTFOUND ; +} + +{ + # override default compare, with duplicates, sort values + my $lex = new LexFile $Dfile, $Dfile2; + my $value ; + my (%h, %g) ; + my @Keys = qw( 0123 9 12 -1234 9 987654321 9 def ) ; + my @Values = qw( 1 11 3 dd x abc 2 0 ) ; + ok 91, tie %h, "BerkeleyDB::Btree", -Filename => $Dfile, + -Compare => sub { $_[0] <=> $_[1] }, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + ok 92, tie %g, 'BerkeleyDB::Btree', -Filename => $Dfile2, + -Compare => sub { $_[0] cmp $_[1] }, + -DupCompare => sub { $_[0] <=> $_[1] }, + -Property => DB_DUP, + + + + -Flags => DB_CREATE ; + + my @srt_1 ; + { local $^W = 0 ; + @srt_1 = sort { $a <=> $b } @Keys ; + } + my @srt_2 = sort { $a cmp $b } @Keys ; + + foreach (@Keys) { + local $^W = 0 ; + my $value = shift @Values ; + $h{$_} = $value ; + $g{$_} = $value ; + } + + ok 93, ArrayCompare (\@srt_1, [keys %h]); + ok 94, ArrayCompare (\@srt_2, [keys %g]); + ok 95, ArrayCompare ([qw(dd 1 3 x 2 11 abc 0)], [getValues \%g]); + ok 96, ArrayCompare ([qw(dd 0 11 2 x 3 1 abc)], [getValues \%h]); + +} + +{ + # get_dup etc + my $lex = new LexFile $Dfile; + my %hh ; + + ok 97, my $YY = tie %hh, "BerkeleyDB::Btree", -Filename => $Dfile, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + $hh{'Wall'} = 'Larry' ; + $hh{'Wall'} = 'Stone' ; # Note the duplicate key + $hh{'Wall'} = 'Brick' ; # Note the duplicate key + $hh{'Smith'} = 'John' ; + $hh{'mouse'} = 'mickey' ; + + # first work in scalar context + ok 98, scalar $YY->get_dup('Unknown') == 0 ; + ok 99, scalar $YY->get_dup('Smith') == 1 ; + ok 100, scalar $YY->get_dup('Wall') == 3 ; + + # now in list context + my @unknown = $YY->get_dup('Unknown') ; + ok 101, "@unknown" eq "" ; + + my @smith = $YY->get_dup('Smith') ; + ok 102, "@smith" eq "John" ; + + { + my @wall = $YY->get_dup('Wall') ; + my %wall ; + @wall{@wall} = @wall ; + ok 103, (@wall == 3 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}); + } + + # hash + my %unknown = $YY->get_dup('Unknown', 1) ; + ok 104, keys %unknown == 0 ; + + my %smith = $YY->get_dup('Smith', 1) ; + ok 105, keys %smith == 1 && $smith{'John'} ; + + my %wall = $YY->get_dup('Wall', 1) ; + ok 106, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 + && $wall{'Brick'} == 1 ; + + undef $YY ; + untie %hh ; + +} + +{ + # in-memory file + + my $lex = new LexFile $Dfile ; + my %hash ; + my $fd ; + my $value ; + ok 107, my $db = tie %hash, 'BerkeleyDB::Btree' ; + + ok 108, $db->db_put("some key", "some value") == 0 ; + ok 109, $db->db_get("some key", $value) == 0 ; + ok 110, $value eq "some value" ; + +} + +{ + # partial + # check works via API + + my $lex = new LexFile $Dfile ; + my $value ; + ok 111, my $db = new BerkeleyDB::Btree, -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db->db_put($k, $v) ; + } + ok 112, $ret == 0 ; + + + # do a partial get + my ($pon, $off, $len) = $db->partial_set(0,2) ; + ok 113, ! $pon && $off == 0 && $len == 0 ; + ok 114, $db->db_get("red", $value) == 0 && $value eq "bo" ; + ok 115, $db->db_get("green", $value) == 0 && $value eq "ho" ; + ok 116, $db->db_get("blue", $value) == 0 && $value eq "se" ; + + # do a partial get, off end of data + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 117, $pon ; + ok 118, $off == 0 ; + ok 119, $len == 2 ; + ok 120, $db->db_get("red", $value) == 0 && $value eq "t" ; + ok 121, $db->db_get("green", $value) == 0 && $value eq "se" ; + ok 122, $db->db_get("blue", $value) == 0 && $value eq "" ; + + # switch of partial mode + ($pon, $off, $len) = $db->partial_clear() ; + ok 123, $pon ; + ok 124, $off == 3 ; + ok 125, $len == 2 ; + ok 126, $db->db_get("red", $value) == 0 && $value eq "boat" ; + ok 127, $db->db_get("green", $value) == 0 && $value eq "house" ; + ok 128, $db->db_get("blue", $value) == 0 && $value eq "sea" ; + + # now partial put + $db->partial_set(0,2) ; + ok 129, $db->db_put("red", "") == 0 ; + ok 130, $db->db_put("green", "AB") == 0 ; + ok 131, $db->db_put("blue", "XYZ") == 0 ; + ok 132, $db->db_put("new", "KLM") == 0 ; + + ($pon, $off, $len) = $db->partial_clear() ; + ok 133, $pon ; + ok 134, $off == 0 ; + ok 135, $len == 2 ; + ok 136, $db->db_get("red", $value) == 0 && $value eq "at" ; + ok 137, $db->db_get("green", $value) == 0 && $value eq "ABuse" ; + ok 138, $db->db_get("blue", $value) == 0 && $value eq "XYZa" ; + ok 139, $db->db_get("new", $value) == 0 && $value eq "KLM" ; + + # now partial put + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 140, ! $pon ; + ok 141, $off == 0 ; + ok 142, $len == 0 ; + ok 143, $db->db_put("red", "PPP") == 0 ; + ok 144, $db->db_put("green", "Q") == 0 ; + ok 145, $db->db_put("blue", "XYZ") == 0 ; + ok 146, $db->db_put("new", "TU") == 0 ; + + $db->partial_clear() ; + ok 147, $db->db_get("red", $value) == 0 && $value eq "at\0PPP" ; + ok 148, $db->db_get("green", $value) == 0 && $value eq "ABuQ" ; + ok 149, $db->db_get("blue", $value) == 0 && $value eq "XYZXYZ" ; + ok 150, $db->db_get("new", $value) == 0 && $value eq "KLMTU" ; +} + +{ + # partial + # check works via tied hash + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + ok 151, my $db = tie %hash, 'BerkeleyDB::Btree', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + while (my ($k, $v) = each %data) { + $hash{$k} = $v ; + } + + + # do a partial get + $db->partial_set(0,2) ; + ok 152, $hash{"red"} eq "bo" ; + ok 153, $hash{"green"} eq "ho" ; + ok 154, $hash{"blue"} eq "se" ; + + # do a partial get, off end of data + $db->partial_set(3,2) ; + ok 155, $hash{"red"} eq "t" ; + ok 156, $hash{"green"} eq "se" ; + ok 157, $hash{"blue"} eq "" ; + + # switch of partial mode + $db->partial_clear() ; + ok 158, $hash{"red"} eq "boat" ; + ok 159, $hash{"green"} eq "house" ; + ok 160, $hash{"blue"} eq "sea" ; + + # now partial put + $db->partial_set(0,2) ; + ok 161, $hash{"red"} = "" ; + ok 162, $hash{"green"} = "AB" ; + ok 163, $hash{"blue"} = "XYZ" ; + ok 164, $hash{"new"} = "KLM" ; + + $db->partial_clear() ; + ok 165, $hash{"red"} eq "at" ; + ok 166, $hash{"green"} eq "ABuse" ; + ok 167, $hash{"blue"} eq "XYZa" ; + ok 168, $hash{"new"} eq "KLM" ; + + # now partial put + $db->partial_set(3,2) ; + ok 169, $hash{"red"} = "PPP" ; + ok 170, $hash{"green"} = "Q" ; + ok 171, $hash{"blue"} = "XYZ" ; + ok 172, $hash{"new"} = "TU" ; + + $db->partial_clear() ; + ok 173, $hash{"red"} eq "at\0PPP" ; + ok 174, $hash{"green"} eq "ABuQ" ; + ok 175, $hash{"blue"} eq "XYZXYZ" ; + ok 176, $hash{"new"} eq "KLMTU" ; +} + +{ + # transaction + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 177, my $lexD = new LexDir($home) ; + ok 178, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 179, my $txn = $env->txn_begin() ; + ok 180, my $db1 = tie %hash, 'BerkeleyDB::Btree', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + ok 181, (my $Z = $txn->txn_commit()) == 0 ; + ok 182, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 183, $ret == 0 ; + + # should be able to see all the records + + ok 184, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 185, $count == 3 ; + undef $cursor ; + + # now abort the transaction + #ok 151, $txn->txn_abort() == 0 ; + ok 186, ($Z = $txn->txn_abort()) == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 187, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 188, $count == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie %hash ; +} + +{ + # DB_DUP + + my $lex = new LexFile $Dfile ; + my %hash ; + ok 189, my $db = tie %hash, 'BerkeleyDB::Btree', -Filename => $Dfile, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + $hash{'Wall'} = 'Larry' ; + $hash{'Wall'} = 'Stone' ; + $hash{'Smith'} = 'John' ; + $hash{'Wall'} = 'Brick' ; + $hash{'Wall'} = 'Brick' ; + $hash{'mouse'} = 'mickey' ; + + ok 190, keys %hash == 6 ; + + # create a cursor + ok 191, my $cursor = $db->db_cursor() ; + + my $key = "Wall" ; + my $value ; + ok 192, $cursor->c_get($key, $value, DB_SET) == 0 ; + ok 193, $key eq "Wall" && $value eq "Larry" ; + ok 194, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 195, $key eq "Wall" && $value eq "Stone" ; + ok 196, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 197, $key eq "Wall" && $value eq "Brick" ; + ok 198, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 199, $key eq "Wall" && $value eq "Brick" ; + + #my $ref = $db->db_stat() ; + #ok 200, ($ref->{bt_flags} | DB_DUP) == DB_DUP ; +#print "bt_flags " . $ref->{bt_flags} . " DB_DUP " . DB_DUP ."\n"; + + undef $db ; + undef $cursor ; + untie %hash ; + +} + +{ + # db_stat + + my $lex = new LexFile $Dfile ; + my $recs = ($BerkeleyDB::db_version >= 3.1 ? "bt_ndata" : "bt_nrecs") ; + my %hash ; + my ($k, $v) ; + ok 200, my $db = new BerkeleyDB::Btree -Filename => $Dfile, + -Flags => DB_CREATE, + -Minkey =>3 , + -Pagesize => 2 **12 + ; + + my $ref = $db->db_stat() ; + ok 201, $ref->{$recs} == 0; + ok 202, $ref->{'bt_minkey'} == 3; + ok 203, $ref->{'bt_pagesize'} == 2 ** 12; + + # create some data + my %data = ( + "red" => 2, + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (($k, $v) = each %data) { + $ret += $db->db_put($k, $v) ; + } + ok 204, $ret == 0 ; + + $ref = $db->db_stat() ; + ok 205, $ref->{$recs} == 3; +} + +{ + # sub-class test + + package Another ; + + use strict ; + + open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; + print FILE <<'EOM' ; + + package SubDB ; + + use strict ; + use vars qw( @ISA @EXPORT) ; + + require Exporter ; + use BerkeleyDB; + @ISA=qw(BerkeleyDB::Btree); + @EXPORT = @BerkeleyDB::EXPORT ; + + sub db_put { + my $self = shift ; + my $key = shift ; + my $value = shift ; + $self->SUPER::db_put($key, $value * 3) ; + } + + sub db_get { + my $self = shift ; + $self->SUPER::db_get($_[0], $_[1]) ; + $_[1] -= 2 ; + } + + sub A_new_method + { + my $self = shift ; + my $key = shift ; + my $value = $self->FETCH($key) ; + return "[[$value]]" ; + } + + 1 ; +EOM + + close FILE ; + + BEGIN { push @INC, '.'; } + eval 'use SubDB ; '; + main::ok 206, $@ eq "" ; + my %h ; + my $X ; + eval ' + $X = tie(%h, "SubDB", -Filename => "dbbtree.tmp", + -Flags => DB_CREATE, + -Mode => 0640 ); + ' ; + + main::ok 207, $@ eq "" && $X ; + + my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; + main::ok 208, $@ eq "" ; + main::ok 209, $ret == 7 ; + + my $value = 0; + $ret = eval '$X->db_put("joe", 4) ; $X->db_get("joe", $value) ; return $value' ; + main::ok 210, $@ eq "" ; + main::ok 211, $ret == 10 ; + + $ret = eval ' DB_NEXT eq main::DB_NEXT ' ; + main::ok 212, $@ eq "" ; + main::ok 213, $ret == 1 ; + + $ret = eval '$X->A_new_method("joe") ' ; + main::ok 214, $@ eq "" ; + main::ok 215, $ret eq "[[10]]" ; + + undef $X; + untie %h; + unlink "SubDB.pm", "dbbtree.tmp" ; + +} + +{ + # DB_RECNUM, DB_SET_RECNO & DB_GET_RECNO + + my $lex = new LexFile $Dfile ; + my %hash ; + my ($k, $v) = ("", ""); + ok 216, my $db = new BerkeleyDB::Btree + -Filename => $Dfile, + -Flags => DB_CREATE, + -Property => DB_RECNUM ; + + + # create some data + my @data = ( + "A zero", + "B one", + "C two", + "D three", + "E four" + ) ; + + my $ix = 0 ; + my $ret = 0 ; + foreach (@data) { + $ret += $db->db_put($_, $ix) ; + ++ $ix ; + } + ok 217, $ret == 0 ; + + # db_get & DB_SET_RECNO + $k = 1 ; + ok 218, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 219, $k eq "B one" && $v == 1 ; + + $k = 3 ; + ok 220, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 221, $k eq "D three" && $v == 3 ; + + $k = 4 ; + ok 222, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 223, $k eq "E four" && $v == 4 ; + + $k = 0 ; + ok 224, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 225, $k eq "A zero" && $v == 0 ; + + # cursor & DB_SET_RECNO + + # create the cursor + ok 226, my $cursor = $db->db_cursor() ; + + $k = 2 ; + ok 227, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 228, $k eq "C two" && $v == 2 ; + + $k = 0 ; + ok 229, $cursor->c_get($k, $v, DB_SET_RECNO) == 0; + ok 230, $k eq "A zero" && $v == 0 ; + + $k = 3 ; + ok 231, $db->db_get($k, $v, DB_SET_RECNO) == 0; + ok 232, $k eq "D three" && $v == 3 ; + + # cursor & DB_GET_RECNO + ok 233, $cursor->c_get($k, $v, DB_FIRST) == 0 ; + ok 234, $k eq "A zero" && $v == 0 ; + ok 235, $cursor->c_get($k, $v, DB_GET_RECNO) == 0; + ok 236, $v == 0 ; + + ok 237, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 238, $k eq "B one" && $v == 1 ; + ok 239, $cursor->c_get($k, $v, DB_GET_RECNO) == 0; + ok 240, $v == 1 ; + + ok 241, $cursor->c_get($k, $v, DB_LAST) == 0 ; + ok 242, $k eq "E four" && $v == 4 ; + ok 243, $cursor->c_get($k, $v, DB_GET_RECNO) == 0; + ok 244, $v == 4 ; + +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/destroy.t b/storage/bdb/perl/BerkeleyDB/t/destroy.t new file mode 100644 index 00000000000..7457d36c583 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/destroy.t @@ -0,0 +1,105 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..15\n"; + +my $Dfile = "dbhash.tmp"; +my $home = "./fred" ; + +umask(0); + +{ + # let object destruction kill everything + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + ok 1, my $lexD = new LexDir($home) ; + ok 2, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 3, my $txn = $env->txn_begin() ; + ok 4, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + ok 5, $txn->txn_commit() == 0 ; + ok 6, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 7, $ret == 0 ; + + # should be able to see all the records + + ok 8, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 9, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 10, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 11, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 12, $count == 0 ; + + #undef $txn ; + #undef $cursor ; + #undef $db1 ; + #undef $env ; + #untie %hash ; + +} + +{ + my $lex = new LexFile $Dfile ; + my %hash ; + my $cursor ; + my ($k, $v) = ("", "") ; + ok 13, my $db1 = tie %hash, 'BerkeleyDB::Hash', + -Filename => $Dfile, + -Flags => DB_CREATE ; + my $count = 0 ; + # sequence forwards + ok 14, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 15, $count == 0 ; +} + + diff --git a/storage/bdb/perl/BerkeleyDB/t/env.t b/storage/bdb/perl/BerkeleyDB/t/env.t new file mode 100644 index 00000000000..3905abfae43 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/env.t @@ -0,0 +1,217 @@ +#!./perl -w + +# ID: 1.2, 7/17/97 + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..47\n"; + +my $Dfile = "dbhash.tmp"; + +umask(0); + +{ + # db version stuff + my ($major, $minor, $patch) = (0, 0, 0) ; + + ok 1, my $VER = BerkeleyDB::DB_VERSION_STRING ; + ok 2, my $ver = BerkeleyDB::db_version($major, $minor, $patch) ; + ok 3, $VER eq $ver ; + ok 4, $major > 1 ; + ok 5, defined $minor ; + ok 6, defined $patch ; +} + +{ + # Check for invalid parameters + my $env ; + eval ' $env = new BerkeleyDB::Env( -Stupid => 3) ; ' ; + ok 7, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $env = new BerkeleyDB::Env( -Bad => 2, -Home => "/tmp", -Stupid => 3) ; ' ; + ok 8, $@ =~ /unknown key value\(s\) (Bad |Stupid ){2}/ ; + + eval ' $env = new BerkeleyDB::Env (-Config => {"fred" => " "} ) ; ' ; + ok 9, !$env ; + ok 10, $BerkeleyDB::Error =~ /^illegal name-value pair/ ; +} + +{ + # create a very simple environment + my $home = "./fred" ; + ok 11, my $lexD = new LexDir($home) ; + chdir "./fred" ; + ok 12, my $env = new BerkeleyDB::Env -Flags => DB_CREATE ; + chdir ".." ; + undef $env ; +} + +{ + # create an environment with a Home + my $home = "./fred" ; + ok 13, my $lexD = new LexDir($home) ; + ok 14, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE ; + + undef $env ; +} + +{ + # make new fail. + my $home = "./not_there" ; + rmtree $home ; + ok 15, ! -d $home ; + my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_INIT_LOCK ; + ok 16, ! $env ; + ok 17, $! != 0 || $^E != 0 ; + + rmtree $home ; +} + +{ + # Config + use Cwd ; + my $cwd = cwd() ; + my $home = "$cwd/fred" ; + my $data_dir = "$home/data_dir" ; + my $log_dir = "$home/log_dir" ; + my $data_file = "data.db" ; + ok 18, my $lexD = new LexDir($home) ; + ok 19, -d $data_dir ? chmod 0777, $data_dir : mkdir($data_dir, 0777) ; + ok 20, -d $log_dir ? chmod 0777, $log_dir : mkdir($log_dir, 0777) ; + my $env = new BerkeleyDB::Env -Home => $home, + -Config => { DB_DATA_DIR => $data_dir, + DB_LOG_DIR => $log_dir + }, + -Flags => DB_CREATE|DB_INIT_TXN|DB_INIT_LOG| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 21, $env ; + + ok 22, my $txn = $env->txn_begin() ; + + my %hash ; + ok 23, tie %hash, 'BerkeleyDB::Hash', -Filename => $data_file, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + $hash{"abc"} = 123 ; + $hash{"def"} = 456 ; + + $txn->txn_commit() ; + + untie %hash ; + + undef $txn ; + undef $env ; +} + +{ + # -ErrFile with a filename + my $errfile = "./errfile" ; + my $home = "./fred" ; + ok 24, my $lexD = new LexDir($home) ; + my $lex = new LexFile $errfile ; + ok 25, my $env = new BerkeleyDB::Env( -ErrFile => $errfile, + -Flags => DB_CREATE, + -Home => $home) ; + my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Env => $env, + -Flags => -1; + ok 26, !$db ; + + ok 27, $BerkeleyDB::Error =~ /^illegal flag specified to (db_open|DB->open)/; + ok 28, -e $errfile ; + my $contents = docat($errfile) ; + chomp $contents ; + ok 29, $BerkeleyDB::Error eq $contents ; + + undef $env ; +} + +{ + # -ErrFile with a filehandle/reference -- should fail + my $home = "./fred" ; + ok 30, my $lexD = new LexDir($home) ; + eval { my $env = new BerkeleyDB::Env( -ErrFile => [], + -Flags => DB_CREATE, + -Home => $home) ; }; + ok 31, $@ =~ /ErrFile parameter must be a file name/; +} + +{ + # -ErrPrefix + use IO ; + my $home = "./fred" ; + ok 32, my $lexD = new LexDir($home) ; + my $errfile = "./errfile" ; + my $lex = new LexFile $errfile ; + ok 33, my $env = new BerkeleyDB::Env( -ErrFile => $errfile, + -ErrPrefix => "PREFIX", + -Flags => DB_CREATE, + -Home => $home) ; + my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Env => $env, + -Flags => -1; + ok 34, !$db ; + + ok 35, $BerkeleyDB::Error =~ /^PREFIX: illegal flag specified to (db_open|DB->open)/; + ok 36, -e $errfile ; + my $contents = docat($errfile) ; + chomp $contents ; + ok 37, $BerkeleyDB::Error eq $contents ; + + # change the prefix on the fly + my $old = $env->errPrefix("NEW ONE") ; + ok 38, $old eq "PREFIX" ; + + $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Env => $env, + -Flags => -1; + ok 39, !$db ; + ok 40, $BerkeleyDB::Error =~ /^NEW ONE: illegal flag specified to (db_open|DB->open)/; + $contents = docat($errfile) ; + chomp $contents ; + ok 41, $contents =~ /$BerkeleyDB::Error$/ ; + undef $env ; +} + +{ + # test db_appexit + use Cwd ; + my $cwd = cwd() ; + my $home = "$cwd/fred" ; + my $data_dir = "$home/data_dir" ; + my $log_dir = "$home/log_dir" ; + my $data_file = "data.db" ; + ok 42, my $lexD = new LexDir($home); + ok 43, -d $data_dir ? chmod 0777, $data_dir : mkdir($data_dir, 0777) ; + ok 44, -d $log_dir ? chmod 0777, $log_dir : mkdir($log_dir, 0777) ; + my $env = new BerkeleyDB::Env -Home => $home, + -Config => { DB_DATA_DIR => $data_dir, + DB_LOG_DIR => $log_dir + }, + -Flags => DB_CREATE|DB_INIT_TXN|DB_INIT_LOG| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 45, $env ; + + ok 46, my $txn_mgr = $env->TxnMgr() ; + + ok 47, $env->db_appexit() == 0 ; + +} + +# test -Verbose +# test -Flags +# db_value_set diff --git a/storage/bdb/perl/BerkeleyDB/t/examples.t b/storage/bdb/perl/BerkeleyDB/t/examples.t new file mode 100644 index 00000000000..69b7f8ff8c5 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/examples.t @@ -0,0 +1,401 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util; + +print "1..7\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +my $redirect = "xyzt" ; + + +{ +my $x = $BerkeleyDB::Error; +my $redirect = "xyzt" ; + { + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + use vars qw( %h $k $v ) ; + + my $filename = "fruit" ; + unlink $filename ; + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $h{"apple"} = "red" ; + $h{"orange"} = "orange" ; + $h{"banana"} = "yellow" ; + $h{"tomato"} = "red" ; + + # Check for existence of a key + print "Banana Exists\n\n" if $h{"banana"} ; + + # Delete a key/value pair. + delete $h{"apple"} ; + + # print the contents of the file + while (($k, $v) = each %h) + { print "$k -> $v\n" } + + untie %h ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(1, docat_del($redirect) eq <<'EOM') ; +Banana Exists + +orange -> orange +tomato -> red +banana -> yellow +EOM + + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("apple", "red") ; + $db->db_put("orange", "orange") ; + $db->db_put("banana", "yellow") ; + $db->db_put("tomato", "red") ; + + # Check for existence of a key + print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0; + + # Delete a key/value pair. + $db->db_del("apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(2, docat_del($redirect) eq <<'EOM') ; +Banana Exists + +orange -> orange +tomato -> red +banana -> yellow +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(3, docat_del($redirect) eq <<'EOM') ; +Smith +Wall +mouse +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE, + -Compare => sub { lc $_[0] cmp lc $_[1] } + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(4, docat_del($redirect) eq <<'EOM') ; +mouse +Smith +Wall +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + my $db = tie %hash, 'BerkeleyDB::Hash', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Install DBM Filters + $db->filter_fetch_key ( sub { s/\0$// } ) ; + $db->filter_store_key ( sub { $_ .= "\0" } ) ; + $db->filter_fetch_value( sub { s/\0$// } ) ; + $db->filter_store_value( sub { $_ .= "\0" } ) ; + + $hash{"abc"} = "def" ; + my $a = $hash{"ABC"} ; + # ... + undef $db ; + untie %hash ; + $db = tie %hash, 'BerkeleyDB::Hash', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + while (($k, $v) = each %hash) + { print "$k -> $v\n" } + undef $db ; + untie %hash ; + + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(5, docat_del($redirect) eq <<"EOM") ; +abc\x00 -> def\x00 +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + + my $db = tie %hash, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + $db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ; + $db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ; + $hash{123} = "def" ; + # ... + undef $db ; + untie %hash ; + $db = tie %hash, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot Open $filename: $!\n" ; + while (($k, $v) = each %hash) + { print "$k -> $v\n" } + undef $db ; + untie %hash ; + + unlink $filename ; + } + + my $val = pack("i", 123) ; + #print "[" . docat($redirect) . "]\n" ; + ok(6, docat_del($redirect) eq <<"EOM") ; +$val -> def +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + if ($FA) { + use strict ; + use BerkeleyDB ; + + my $filename = "text" ; + unlink $filename ; + + my @h ; + tie @h, 'BerkeleyDB::Recno', + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_RENUMBER + or die "Cannot open $filename: $!\n" ; + + # Add a few key/value pairs to the file + $h[0] = "orange" ; + $h[1] = "blue" ; + $h[2] = "yellow" ; + + push @h, "green", "black" ; + + my $elements = scalar @h ; + print "The array contains $elements entries\n" ; + + my $last = pop @h ; + print "popped $last\n" ; + + unshift @h, "white" ; + my $first = shift @h ; + print "shifted $first\n" ; + + # Check for existence of a key + print "Element 1 Exists with value $h[1]\n" if $h[1] ; + + untie @h ; + unlink $filename ; + } else { + use strict ; + use BerkeleyDB ; + + my $filename = "text" ; + unlink $filename ; + + my @h ; + my $db = tie @h, 'BerkeleyDB::Recno', + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_RENUMBER + or die "Cannot open $filename: $!\n" ; + + # Add a few key/value pairs to the file + $h[0] = "orange" ; + $h[1] = "blue" ; + $h[2] = "yellow" ; + + $db->push("green", "black") ; + + my $elements = $db->length() ; + print "The array contains $elements entries\n" ; + + my $last = $db->pop ; + print "popped $last\n" ; + + $db->unshift("white") ; + my $first = $db->shift ; + print "shifted $first\n" ; + + # Check for existence of a key + print "Element 1 Exists with value $h[1]\n" if $h[1] ; + + undef $db ; + untie @h ; + unlink $filename ; + } + + } + + #print "[" . docat($redirect) . "]\n" ; + ok(7, docat_del($redirect) eq <<"EOM") ; +The array contains 5 entries +popped black +shifted white +Element 1 Exists with value blue +EOM + +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/examples.t.T b/storage/bdb/perl/BerkeleyDB/t/examples.t.T new file mode 100644 index 00000000000..fe9bdf76b06 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/examples.t.T @@ -0,0 +1,415 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util; + +print "1..7\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +my $redirect = "xyzt" ; + + +{ +my $x = $BerkeleyDB::Error; +my $redirect = "xyzt" ; + { + my $redirectObj = new Redirect $redirect ; + +## BEGIN simpleHash + use strict ; + use BerkeleyDB ; + use vars qw( %h $k $v ) ; + + my $filename = "fruit" ; + unlink $filename ; + tie %h, "BerkeleyDB::Hash", + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $h{"apple"} = "red" ; + $h{"orange"} = "orange" ; + $h{"banana"} = "yellow" ; + $h{"tomato"} = "red" ; + + # Check for existence of a key + print "Banana Exists\n\n" if $h{"banana"} ; + + # Delete a key/value pair. + delete $h{"apple"} ; + + # print the contents of the file + while (($k, $v) = each %h) + { print "$k -> $v\n" } + + untie %h ; +## END simpleHash + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(1, docat_del($redirect) eq <<'EOM') ; +Banana Exists + +orange -> orange +tomato -> red +banana -> yellow +EOM + + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN simpleHash2 + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("apple", "red") ; + $db->db_put("orange", "orange") ; + $db->db_put("banana", "yellow") ; + $db->db_put("tomato", "red") ; + + # Check for existence of a key + print "Banana Exists\n\n" if $db->db_get("banana", $v) == 0; + + # Delete a key/value pair. + $db->db_del("apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; +## END simpleHash2 + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(2, docat_del($redirect) eq <<'EOM') ; +Banana Exists + +orange -> orange +tomato -> red +banana -> yellow +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN btreeSimple + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; +## END btreeSimple + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(3, docat_del($redirect) eq <<'EOM') ; +Smith +Wall +mouse +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN btreeSortOrder + use strict ; + use BerkeleyDB ; + + my $filename = "tree" ; + unlink $filename ; + my %h ; + tie %h, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE, + -Compare => sub { lc $_[0] cmp lc $_[1] } + or die "Cannot open $filename: $!\n" ; + + # Add a key/value pair to the file + $h{'Wall'} = 'Larry' ; + $h{'Smith'} = 'John' ; + $h{'mouse'} = 'mickey' ; + $h{'duck'} = 'donald' ; + + # Delete + delete $h{"duck"} ; + + # Cycle through the keys printing them in order. + # Note it is not necessary to sort the keys as + # the btree will have kept them in order automatically. + foreach (keys %h) + { print "$_\n" } + + untie %h ; +## END btreeSortOrder + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(4, docat_del($redirect) eq <<'EOM') ; +mouse +Smith +Wall +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN nullFilter + use strict ; + use BerkeleyDB ; + + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + my $db = tie %hash, 'BerkeleyDB::Hash', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + # Install DBM Filters + $db->filter_fetch_key ( sub { s/\0$// } ) ; + $db->filter_store_key ( sub { $_ .= "\0" } ) ; + $db->filter_fetch_value( sub { s/\0$// } ) ; + $db->filter_store_value( sub { $_ .= "\0" } ) ; + + $hash{"abc"} = "def" ; + my $a = $hash{"ABC"} ; + # ... + undef $db ; + untie %hash ; +## END nullFilter + $db = tie %hash, 'BerkeleyDB::Hash', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + while (($k, $v) = each %hash) + { print "$k -> $v\n" } + undef $db ; + untie %hash ; + + unlink $filename ; + } + + #print "[" . docat($redirect) . "]\n" ; + ok(5, docat_del($redirect) eq <<"EOM") ; +abc\x00 -> def\x00 +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN intFilter + use strict ; + use BerkeleyDB ; + my %hash ; + my $filename = "filt.db" ; + unlink $filename ; + + + my $db = tie %hash, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot open $filename: $!\n" ; + + $db->filter_fetch_key ( sub { $_ = unpack("i", $_) } ) ; + $db->filter_store_key ( sub { $_ = pack ("i", $_) } ) ; + $hash{123} = "def" ; + # ... + undef $db ; + untie %hash ; +## END intFilter + $db = tie %hash, 'BerkeleyDB::Btree', + -Filename => $filename, + -Flags => DB_CREATE + or die "Cannot Open $filename: $!\n" ; + while (($k, $v) = each %hash) + { print "$k -> $v\n" } + undef $db ; + untie %hash ; + + unlink $filename ; + } + + my $val = pack("i", 123) ; + #print "[" . docat($redirect) . "]\n" ; + ok(6, docat_del($redirect) eq <<"EOM") ; +$val -> def +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + if ($FA) { +## BEGIN simpleRecno + use strict ; + use BerkeleyDB ; + + my $filename = "text" ; + unlink $filename ; + + my @h ; + tie @h, 'BerkeleyDB::Recno', + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_RENUMBER + or die "Cannot open $filename: $!\n" ; + + # Add a few key/value pairs to the file + $h[0] = "orange" ; + $h[1] = "blue" ; + $h[2] = "yellow" ; + + push @h, "green", "black" ; + + my $elements = scalar @h ; + print "The array contains $elements entries\n" ; + + my $last = pop @h ; + print "popped $last\n" ; + + unshift @h, "white" ; + my $first = shift @h ; + print "shifted $first\n" ; + + # Check for existence of a key + print "Element 1 Exists with value $h[1]\n" if $h[1] ; + + untie @h ; +## END simpleRecno + unlink $filename ; + } else { + use strict ; + use BerkeleyDB ; + + my $filename = "text" ; + unlink $filename ; + + my @h ; + my $db = tie @h, 'BerkeleyDB::Recno', + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_RENUMBER + or die "Cannot open $filename: $!\n" ; + + # Add a few key/value pairs to the file + $h[0] = "orange" ; + $h[1] = "blue" ; + $h[2] = "yellow" ; + + $db->push("green", "black") ; + + my $elements = $db->length() ; + print "The array contains $elements entries\n" ; + + my $last = $db->pop ; + print "popped $last\n" ; + + $db->unshift("white") ; + my $first = $db->shift ; + print "shifted $first\n" ; + + # Check for existence of a key + print "Element 1 Exists with value $h[1]\n" if $h[1] ; + + undef $db ; + untie @h ; + unlink $filename ; + } + + } + + #print "[" . docat($redirect) . "]\n" ; + ok(7, docat_del($redirect) eq <<"EOM") ; +The array contains 5 entries +popped black +shifted white +Element 1 Exists with value blue +EOM + +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/examples3.t b/storage/bdb/perl/BerkeleyDB/t/examples3.t new file mode 100644 index 00000000000..22e94b770e1 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/examples3.t @@ -0,0 +1,132 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util; + +BEGIN +{ + if ($BerkeleyDB::db_version < 3) { + print "1..0 # Skipping test, this needs Berkeley DB 3.x or better\n" ; + exit 0 ; + } +} + + +print "1..2\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +my $redirect = "xyzt" ; + + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(1, docat_del($redirect) eq <<'EOM') ; +orange -> orange +yellow -> banana +red -> apple +red -> tomato +green -> banana +green -> apple +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP | DB_DUPSORT + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(2, docat_del($redirect) eq <<'EOM') ; +orange -> orange +yellow -> banana +red -> apple +red -> tomato +green -> apple +green -> banana +EOM + +} + + diff --git a/storage/bdb/perl/BerkeleyDB/t/examples3.t.T b/storage/bdb/perl/BerkeleyDB/t/examples3.t.T new file mode 100644 index 00000000000..5eeaa14d00c --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/examples3.t.T @@ -0,0 +1,136 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util; + +BEGIN +{ + if ($BerkeleyDB::db_version < 3) { + print "1..0 # Skipping test, this needs Berkeley DB 3.x or better\n" ; + exit 0 ; + } +} + + +print "1..2\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +my $redirect = "xyzt" ; + + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN dupHash + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; +## END dupHash + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(1, docat_del($redirect) eq <<'EOM') ; +orange -> orange +yellow -> banana +red -> apple +red -> tomato +green -> banana +green -> apple +EOM + +} + +{ +my $redirect = "xyzt" ; + { + + my $redirectObj = new Redirect $redirect ; + +## BEGIN dupSortHash + use strict ; + use BerkeleyDB ; + + my $filename = "fruit" ; + unlink $filename ; + my $db = new BerkeleyDB::Hash + -Filename => $filename, + -Flags => DB_CREATE, + -Property => DB_DUP | DB_DUPSORT + or die "Cannot open file $filename: $! $BerkeleyDB::Error\n" ; + + # Add a few key/value pairs to the file + $db->db_put("red", "apple") ; + $db->db_put("orange", "orange") ; + $db->db_put("green", "banana") ; + $db->db_put("yellow", "banana") ; + $db->db_put("red", "tomato") ; + $db->db_put("green", "apple") ; + + # print the contents of the file + my ($k, $v) = ("", "") ; + my $cursor = $db->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { print "$k -> $v\n" } + + undef $cursor ; + undef $db ; +## END dupSortHash + unlink $filename ; + } + + #print "[" . docat($redirect) . "]" ; + ok(2, docat_del($redirect) eq <<'EOM') ; +orange -> orange +yellow -> banana +red -> apple +red -> tomato +green -> apple +green -> banana +EOM + +} + + diff --git a/storage/bdb/perl/BerkeleyDB/t/filter.t b/storage/bdb/perl/BerkeleyDB/t/filter.t new file mode 100644 index 00000000000..47a7c107acf --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/filter.t @@ -0,0 +1,217 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..46\n"; + +my $Dfile = "dbhash.tmp"; +unlink $Dfile; + +umask(0) ; + + +{ + # DBM Filter tests + use strict ; + my (%h, $db) ; + my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + unlink $Dfile; + + sub checkOutput + { + my($fk, $sk, $fv, $sv) = @_ ; + return + $fetch_key eq $fk && $store_key eq $sk && + $fetch_value eq $fv && $store_value eq $sv && + $_ eq 'original' ; + } + + ok 1, $db = tie %h, 'BerkeleyDB::Hash', + -Filename => $Dfile, + -Flags => DB_CREATE; + + $db->filter_fetch_key (sub { $fetch_key = $_ }) ; + $db->filter_store_key (sub { $store_key = $_ }) ; + $db->filter_fetch_value (sub { $fetch_value = $_}) ; + $db->filter_store_value (sub { $store_value = $_ }) ; + + $_ = "original" ; + + $h{"fred"} = "joe" ; + # fk sk fv sv + ok 2, checkOutput( "", "fred", "", "joe") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 3, $h{"fred"} eq "joe"; + # fk sk fv sv + ok 4, checkOutput( "", "fred", "joe", "") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 5, $db->FIRSTKEY() eq "fred" ; + # fk sk fv sv + ok 6, checkOutput( "fred", "", "", "") ; + + # replace the filters, but remember the previous set + my ($old_fk) = $db->filter_fetch_key + (sub { $_ = uc $_ ; $fetch_key = $_ }) ; + my ($old_sk) = $db->filter_store_key + (sub { $_ = lc $_ ; $store_key = $_ }) ; + my ($old_fv) = $db->filter_fetch_value + (sub { $_ = "[$_]"; $fetch_value = $_ }) ; + my ($old_sv) = $db->filter_store_value + (sub { s/o/x/g; $store_value = $_ }) ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h{"Fred"} = "Joe" ; + # fk sk fv sv + ok 7, checkOutput( "", "fred", "", "Jxe") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 8, $h{"Fred"} eq "[Jxe]"; + # fk sk fv sv + ok 9, checkOutput( "", "fred", "[Jxe]", "") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 10, $db->FIRSTKEY() eq "FRED" ; + # fk sk fv sv + ok 11, checkOutput( "FRED", "", "", "") ; + + # put the original filters back + $db->filter_fetch_key ($old_fk); + $db->filter_store_key ($old_sk); + $db->filter_fetch_value ($old_fv); + $db->filter_store_value ($old_sv); + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h{"fred"} = "joe" ; + ok 12, checkOutput( "", "fred", "", "joe") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 13, $h{"fred"} eq "joe"; + ok 14, checkOutput( "", "fred", "joe", "") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 15, $db->FIRSTKEY() eq "fred" ; + ok 16, checkOutput( "fred", "", "", "") ; + + # delete the filters + $db->filter_fetch_key (undef); + $db->filter_store_key (undef); + $db->filter_fetch_value (undef); + $db->filter_store_value (undef); + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + $h{"fred"} = "joe" ; + ok 17, checkOutput( "", "", "", "") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 18, $h{"fred"} eq "joe"; + ok 19, checkOutput( "", "", "", "") ; + + ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ; + ok 20, $db->FIRSTKEY() eq "fred" ; + ok 21, checkOutput( "", "", "", "") ; + + undef $db ; + untie %h; + unlink $Dfile; +} + +{ + # DBM Filter with a closure + + use strict ; + my (%h, $db) ; + + unlink $Dfile; + ok 22, $db = tie %h, 'BerkeleyDB::Hash', + -Filename => $Dfile, + -Flags => DB_CREATE; + + my %result = () ; + + sub Closure + { + my ($name) = @_ ; + my $count = 0 ; + my @kept = () ; + + return sub { ++$count ; + push @kept, $_ ; + $result{$name} = "$name - $count: [@kept]" ; + } + } + + $db->filter_store_key(Closure("store key")) ; + $db->filter_store_value(Closure("store value")) ; + $db->filter_fetch_key(Closure("fetch key")) ; + $db->filter_fetch_value(Closure("fetch value")) ; + + $_ = "original" ; + + $h{"fred"} = "joe" ; + ok 23, $result{"store key"} eq "store key - 1: [fred]" ; + ok 24, $result{"store value"} eq "store value - 1: [joe]" ; + ok 25, ! defined $result{"fetch key"} ; + ok 26, ! defined $result{"fetch value"} ; + ok 27, $_ eq "original" ; + + ok 28, $db->FIRSTKEY() eq "fred" ; + ok 29, $result{"store key"} eq "store key - 1: [fred]" ; + ok 30, $result{"store value"} eq "store value - 1: [joe]" ; + ok 31, $result{"fetch key"} eq "fetch key - 1: [fred]" ; + ok 32, ! defined $result{"fetch value"} ; + ok 33, $_ eq "original" ; + + $h{"jim"} = "john" ; + ok 34, $result{"store key"} eq "store key - 2: [fred jim]" ; + ok 35, $result{"store value"} eq "store value - 2: [joe john]" ; + ok 36, $result{"fetch key"} eq "fetch key - 1: [fred]" ; + ok 37, ! defined $result{"fetch value"} ; + ok 38, $_ eq "original" ; + + ok 39, $h{"fred"} eq "joe" ; + ok 40, $result{"store key"} eq "store key - 3: [fred jim fred]" ; + ok 41, $result{"store value"} eq "store value - 2: [joe john]" ; + ok 42, $result{"fetch key"} eq "fetch key - 1: [fred]" ; + ok 43, $result{"fetch value"} eq "fetch value - 1: [joe]" ; + ok 44, $_ eq "original" ; + + undef $db ; + untie %h; + unlink $Dfile; +} + +{ + # DBM Filter recursion detection + use strict ; + my (%h, $db) ; + unlink $Dfile; + + ok 45, $db = tie %h, 'BerkeleyDB::Hash', + -Filename => $Dfile, + -Flags => DB_CREATE; + + $db->filter_store_key (sub { $_ = $h{$_} }) ; + + eval '$h{1} = 1234' ; + ok 46, $@ =~ /^BerkeleyDB Aborting: recursion detected in filter_store_key at/ ; + #print "[$@]\n" ; + + undef $db ; + untie %h; + unlink $Dfile; +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/hash.t b/storage/bdb/perl/BerkeleyDB/t/hash.t new file mode 100644 index 00000000000..0e683851c3d --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/hash.t @@ -0,0 +1,728 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..212\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' $db = new BerkeleyDB::Hash -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $db = new BerkeleyDB::Hash -Bad => 2, -Mode => 0345, -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) (Bad |Stupid ){2}/ ; + + eval ' $db = new BerkeleyDB::Hash -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' $db = new BerkeleyDB::Hash -Txn => "fred" ' ; + ok 4, $@ =~ /^Txn not of type BerkeleyDB::Txn/ ; + + my $obj = bless [], "main" ; + eval ' $db = new BerkeleyDB::Hash -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +# Now check the interface to HASH + +{ + my $lex = new LexFile $Dfile ; + + ok 6, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + my $status ; + ok 7, $db->db_put("some key", "some value") == 0 ; + ok 8, $db->status() == 0 ; + ok 9, $db->db_get("some key", $value) == 0 ; + ok 10, $value eq "some value" ; + ok 11, $db->db_put("key", "value") == 0 ; + ok 12, $db->db_get("key", $value) == 0 ; + ok 13, $value eq "value" ; + ok 14, $db->db_del("some key") == 0 ; + ok 15, ($status = $db->db_get("some key", $value)) == DB_NOTFOUND ; + ok 16, $status eq $DB_errors{'DB_NOTFOUND'} ; + ok 17, $db->status() == DB_NOTFOUND ; + ok 18, $db->status() eq $DB_errors{'DB_NOTFOUND'}; + + ok 19, $db->db_sync() == 0 ; + + # Check NOOVERWRITE will make put fail when attempting to overwrite + # an existing record. + + ok 20, $db->db_put( 'key', 'x', DB_NOOVERWRITE) == DB_KEYEXIST ; + ok 21, $db->status() eq $DB_errors{'DB_KEYEXIST'}; + ok 22, $db->status() == DB_KEYEXIST ; + + # check that the value of the key has not been changed by the + # previous test + ok 23, $db->db_get("key", $value) == 0 ; + ok 24, $value eq "value" ; + + # test DB_GET_BOTH + my ($k, $v) = ("key", "value") ; + ok 25, $db->db_get($k, $v, DB_GET_BOTH) == 0 ; + + ($k, $v) = ("key", "fred") ; + ok 26, $db->db_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + ($k, $v) = ("another", "value") ; + ok 27, $db->db_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + +} + +{ + # Check simple env works with a hash. + my $lex = new LexFile $Dfile ; + + my $home = "./fred" ; + ok 28, my $lexD = new LexDir($home); + + ok 29, my $env = new BerkeleyDB::Env -Flags => DB_CREATE| DB_INIT_MPOOL, + -Home => $home ; + ok 30, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Env => $env, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + ok 31, $db->db_put("some key", "some value") == 0 ; + ok 32, $db->db_get("some key", $value) == 0 ; + ok 33, $value eq "some value" ; + undef $db ; + undef $env ; +} + +{ + # override default hash + my $lex = new LexFile $Dfile ; + my $value ; + $::count = 0 ; + ok 34, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Hash => sub { ++$::count ; length $_[0] }, + -Flags => DB_CREATE ; + + ok 35, $db->db_put("some key", "some value") == 0 ; + ok 36, $db->db_get("some key", $value) == 0 ; + ok 37, $value eq "some value" ; + ok 38, $::count > 0 ; + +} + +{ + # cursors + + my $lex = new LexFile $Dfile ; + my %hash ; + my ($k, $v) ; + ok 39, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => 2, + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (($k, $v) = each %data) { + $ret += $db->db_put($k, $v) ; + } + ok 40, $ret == 0 ; + + # create the cursor + ok 41, my $cursor = $db->db_cursor() ; + + $k = $v = "" ; + my %copy = %data ; + my $extras = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 42, $cursor->status() == DB_NOTFOUND ; + ok 43, $cursor->status() eq $DB_errors{'DB_NOTFOUND'} ; + ok 44, keys %copy == 0 ; + ok 45, $extras == 0 ; + + # sequence backwards + %copy = %data ; + $extras = 0 ; + my $status ; + for ( $status = $cursor->c_get($k, $v, DB_LAST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_PREV)) { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 46, $status == DB_NOTFOUND ; + ok 47, $status eq $DB_errors{'DB_NOTFOUND'} ; + ok 48, $cursor->status() == $status ; + ok 49, $cursor->status() eq $status ; + ok 50, keys %copy == 0 ; + ok 51, $extras == 0 ; + + ($k, $v) = ("green", "house") ; + ok 52, $cursor->c_get($k, $v, DB_GET_BOTH) == 0 ; + + ($k, $v) = ("green", "door") ; + ok 53, $cursor->c_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + + ($k, $v) = ("black", "house") ; + ok 54, $cursor->c_get($k, $v, DB_GET_BOTH) == DB_NOTFOUND ; + +} + +{ + # Tied Hash interface + + my $lex = new LexFile $Dfile ; + my %hash ; + ok 55, tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # check "each" with an empty database + my $count = 0 ; + while (my ($k, $v) = each %hash) { + ++ $count ; + } + ok 56, (tied %hash)->status() == DB_NOTFOUND ; + ok 57, $count == 0 ; + + # Add a k/v pair + my $value ; + $hash{"some key"} = "some value"; + ok 58, (tied %hash)->status() == 0 ; + ok 59, $hash{"some key"} eq "some value"; + ok 60, defined $hash{"some key"} ; + ok 61, (tied %hash)->status() == 0 ; + ok 62, exists $hash{"some key"} ; + ok 63, !defined $hash{"jimmy"} ; + ok 64, (tied %hash)->status() == DB_NOTFOUND ; + ok 65, !exists $hash{"jimmy"} ; + ok 66, (tied %hash)->status() == DB_NOTFOUND ; + + delete $hash{"some key"} ; + ok 67, (tied %hash)->status() == 0 ; + ok 68, ! defined $hash{"some key"} ; + ok 69, (tied %hash)->status() == DB_NOTFOUND ; + ok 70, ! exists $hash{"some key"} ; + ok 71, (tied %hash)->status() == DB_NOTFOUND ; + + $hash{1} = 2 ; + $hash{10} = 20 ; + $hash{1000} = 2000 ; + + my ($keys, $values) = (0,0); + $count = 0 ; + while (my ($k, $v) = each %hash) { + $keys += $k ; + $values += $v ; + ++ $count ; + } + ok 72, $count == 3 ; + ok 73, $keys == 1011 ; + ok 74, $values == 2022 ; + + # now clear the hash + %hash = () ; + ok 75, keys %hash == 0 ; + + untie %hash ; +} + +{ + # in-memory file + + my $lex = new LexFile $Dfile ; + my %hash ; + my $fd ; + my $value ; + ok 76, my $db = tie %hash, 'BerkeleyDB::Hash' ; + + ok 77, $db->db_put("some key", "some value") == 0 ; + ok 78, $db->db_get("some key", $value) == 0 ; + ok 79, $value eq "some value" ; + + undef $db ; + untie %hash ; +} + +{ + # partial + # check works via API + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + ok 80, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db->db_put($k, $v) ; + } + ok 81, $ret == 0 ; + + + # do a partial get + my($pon, $off, $len) = $db->partial_set(0,2) ; + ok 82, $pon == 0 && $off == 0 && $len == 0 ; + ok 83, ( $db->db_get("red", $value) == 0) && $value eq "bo" ; + ok 84, ( $db->db_get("green", $value) == 0) && $value eq "ho" ; + ok 85, ( $db->db_get("blue", $value) == 0) && $value eq "se" ; + + # do a partial get, off end of data + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 86, $pon ; + ok 87, $off == 0 ; + ok 88, $len == 2 ; + ok 89, $db->db_get("red", $value) == 0 && $value eq "t" ; + ok 90, $db->db_get("green", $value) == 0 && $value eq "se" ; + ok 91, $db->db_get("blue", $value) == 0 && $value eq "" ; + + # switch of partial mode + ($pon, $off, $len) = $db->partial_clear() ; + ok 92, $pon ; + ok 93, $off == 3 ; + ok 94, $len == 2 ; + ok 95, $db->db_get("red", $value) == 0 && $value eq "boat" ; + ok 96, $db->db_get("green", $value) == 0 && $value eq "house" ; + ok 97, $db->db_get("blue", $value) == 0 && $value eq "sea" ; + + # now partial put + ($pon, $off, $len) = $db->partial_set(0,2) ; + ok 98, ! $pon ; + ok 99, $off == 0 ; + ok 100, $len == 0 ; + ok 101, $db->db_put("red", "") == 0 ; + ok 102, $db->db_put("green", "AB") == 0 ; + ok 103, $db->db_put("blue", "XYZ") == 0 ; + ok 104, $db->db_put("new", "KLM") == 0 ; + + $db->partial_clear() ; + ok 105, $db->db_get("red", $value) == 0 && $value eq "at" ; + ok 106, $db->db_get("green", $value) == 0 && $value eq "ABuse" ; + ok 107, $db->db_get("blue", $value) == 0 && $value eq "XYZa" ; + ok 108, $db->db_get("new", $value) == 0 && $value eq "KLM" ; + + # now partial put + $db->partial_set(3,2) ; + ok 109, $db->db_put("red", "PPP") == 0 ; + ok 110, $db->db_put("green", "Q") == 0 ; + ok 111, $db->db_put("blue", "XYZ") == 0 ; + ok 112, $db->db_put("new", "--") == 0 ; + + ($pon, $off, $len) = $db->partial_clear() ; + ok 113, $pon ; + ok 114, $off == 3 ; + ok 115, $len == 2 ; + ok 116, $db->db_get("red", $value) == 0 && $value eq "at\0PPP" ; + ok 117, $db->db_get("green", $value) == 0 && $value eq "ABuQ" ; + ok 118, $db->db_get("blue", $value) == 0 && $value eq "XYZXYZ" ; + ok 119, $db->db_get("new", $value) == 0 && $value eq "KLM--" ; +} + +{ + # partial + # check works via tied hash + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + ok 120, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + while (my ($k, $v) = each %data) { + $hash{$k} = $v ; + } + + + # do a partial get + $db->partial_set(0,2) ; + ok 121, $hash{"red"} eq "bo" ; + ok 122, $hash{"green"} eq "ho" ; + ok 123, $hash{"blue"} eq "se" ; + + # do a partial get, off end of data + $db->partial_set(3,2) ; + ok 124, $hash{"red"} eq "t" ; + ok 125, $hash{"green"} eq "se" ; + ok 126, $hash{"blue"} eq "" ; + + # switch of partial mode + $db->partial_clear() ; + ok 127, $hash{"red"} eq "boat" ; + ok 128, $hash{"green"} eq "house" ; + ok 129, $hash{"blue"} eq "sea" ; + + # now partial put + $db->partial_set(0,2) ; + ok 130, $hash{"red"} = "" ; + ok 131, $hash{"green"} = "AB" ; + ok 132, $hash{"blue"} = "XYZ" ; + ok 133, $hash{"new"} = "KLM" ; + + $db->partial_clear() ; + ok 134, $hash{"red"} eq "at" ; + ok 135, $hash{"green"} eq "ABuse" ; + ok 136, $hash{"blue"} eq "XYZa" ; + ok 137, $hash{"new"} eq "KLM" ; + + # now partial put + $db->partial_set(3,2) ; + ok 138, $hash{"red"} = "PPP" ; + ok 139, $hash{"green"} = "Q" ; + ok 140, $hash{"blue"} = "XYZ" ; + ok 141, $hash{"new"} = "TU" ; + + $db->partial_clear() ; + ok 142, $hash{"red"} eq "at\0PPP" ; + ok 143, $hash{"green"} eq "ABuQ" ; + ok 144, $hash{"blue"} eq "XYZXYZ" ; + ok 145, $hash{"new"} eq "KLMTU" ; +} + +{ + # transaction + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 146, my $lexD = new LexDir($home); + ok 147, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 148, my $txn = $env->txn_begin() ; + ok 149, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + + ok 150, $txn->txn_commit() == 0 ; + ok 151, $txn = $env->txn_begin() ; + $db1->Txn($txn); + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 152, $ret == 0 ; + + # should be able to see all the records + + ok 153, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 154, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 155, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 156, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 157, $count == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie %hash ; +} + + +{ + # DB_DUP + + my $lex = new LexFile $Dfile ; + my %hash ; + ok 158, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + $hash{'Wall'} = 'Larry' ; + $hash{'Wall'} = 'Stone' ; + $hash{'Smith'} = 'John' ; + $hash{'Wall'} = 'Brick' ; + $hash{'Wall'} = 'Brick' ; + $hash{'mouse'} = 'mickey' ; + + ok 159, keys %hash == 6 ; + + # create a cursor + ok 160, my $cursor = $db->db_cursor() ; + + my $key = "Wall" ; + my $value ; + ok 161, $cursor->c_get($key, $value, DB_SET) == 0 ; + ok 162, $key eq "Wall" && $value eq "Larry" ; + ok 163, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 164, $key eq "Wall" && $value eq "Stone" ; + ok 165, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 166, $key eq "Wall" && $value eq "Brick" ; + ok 167, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 168, $key eq "Wall" && $value eq "Brick" ; + + #my $ref = $db->db_stat() ; + #ok 143, $ref->{bt_flags} | DB_DUP ; + + # test DB_DUP_NEXT + my ($k, $v) = ("Wall", "") ; + ok 169, $cursor->c_get($k, $v, DB_SET) == 0 ; + ok 170, $k eq "Wall" && $v eq "Larry" ; + ok 171, $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ; + ok 172, $k eq "Wall" && $v eq "Stone" ; + ok 173, $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ; + ok 174, $k eq "Wall" && $v eq "Brick" ; + ok 175, $cursor->c_get($k, $v, DB_NEXT_DUP) == 0 ; + ok 176, $k eq "Wall" && $v eq "Brick" ; + ok 177, $cursor->c_get($k, $v, DB_NEXT_DUP) == DB_NOTFOUND ; + + + undef $db ; + undef $cursor ; + untie %hash ; + +} + +{ + # DB_DUP & DupCompare + my $lex = new LexFile $Dfile, $Dfile2; + my ($key, $value) ; + my (%h, %g) ; + my @Keys = qw( 0123 9 12 -1234 9 987654321 9 def ) ; + my @Values = qw( 1 11 3 dd x abc 2 0 ) ; + + ok 178, tie %h, "BerkeleyDB::Hash", -Filename => $Dfile, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP|DB_DUPSORT, + -Flags => DB_CREATE ; + + ok 179, tie %g, 'BerkeleyDB::Hash', -Filename => $Dfile2, + -DupCompare => sub { $_[0] <=> $_[1] }, + -Property => DB_DUP|DB_DUPSORT, + -Flags => DB_CREATE ; + + foreach (@Keys) { + local $^W = 0 ; + my $value = shift @Values ; + $h{$_} = $value ; + $g{$_} = $value ; + } + + ok 180, my $cursor = (tied %h)->db_cursor() ; + $key = 9 ; $value = ""; + ok 181, $cursor->c_get($key, $value, DB_SET) == 0 ; + ok 182, $key == 9 && $value eq 11 ; + ok 183, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 184, $key == 9 && $value == 2 ; + ok 185, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 186, $key == 9 && $value eq "x" ; + + $cursor = (tied %g)->db_cursor() ; + $key = 9 ; + ok 187, $cursor->c_get($key, $value, DB_SET) == 0 ; + ok 188, $key == 9 && $value eq "x" ; + ok 189, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 190, $key == 9 && $value == 2 ; + ok 191, $cursor->c_get($key, $value, DB_NEXT) == 0 ; + ok 192, $key == 9 && $value == 11 ; + + +} + +{ + # get_dup etc + my $lex = new LexFile $Dfile; + my %hh ; + + ok 193, my $YY = tie %hh, "BerkeleyDB::Hash", -Filename => $Dfile, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP, + -Flags => DB_CREATE ; + + $hh{'Wall'} = 'Larry' ; + $hh{'Wall'} = 'Stone' ; # Note the duplicate key + $hh{'Wall'} = 'Brick' ; # Note the duplicate key + $hh{'Smith'} = 'John' ; + $hh{'mouse'} = 'mickey' ; + + # first work in scalar context + ok 194, scalar $YY->get_dup('Unknown') == 0 ; + ok 195, scalar $YY->get_dup('Smith') == 1 ; + ok 196, scalar $YY->get_dup('Wall') == 3 ; + + # now in list context + my @unknown = $YY->get_dup('Unknown') ; + ok 197, "@unknown" eq "" ; + + my @smith = $YY->get_dup('Smith') ; + ok 198, "@smith" eq "John" ; + + { + my @wall = $YY->get_dup('Wall') ; + my %wall ; + @wall{@wall} = @wall ; + ok 199, (@wall == 3 && $wall{'Larry'} + && $wall{'Stone'} && $wall{'Brick'}); + } + + # hash + my %unknown = $YY->get_dup('Unknown', 1) ; + ok 200, keys %unknown == 0 ; + + my %smith = $YY->get_dup('Smith', 1) ; + ok 201, keys %smith == 1 && $smith{'John'} ; + + my %wall = $YY->get_dup('Wall', 1) ; + ok 202, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 + && $wall{'Brick'} == 1 ; + + undef $YY ; + untie %hh ; + +} + +{ + # sub-class test + + package Another ; + + use strict ; + + open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; + print FILE <<'EOM' ; + + package SubDB ; + + use strict ; + use vars qw( @ISA @EXPORT) ; + + require Exporter ; + use BerkeleyDB; + @ISA=qw(BerkeleyDB::Hash); + @EXPORT = @BerkeleyDB::EXPORT ; + + sub db_put { + my $self = shift ; + my $key = shift ; + my $value = shift ; + $self->SUPER::db_put($key, $value * 3) ; + } + + sub db_get { + my $self = shift ; + $self->SUPER::db_get($_[0], $_[1]) ; + $_[1] -= 2 ; + } + + sub A_new_method + { + my $self = shift ; + my $key = shift ; + my $value = $self->FETCH($key) ; + return "[[$value]]" ; + } + + 1 ; +EOM + + close FILE ; + + BEGIN { push @INC, '.'; } + eval 'use SubDB ; '; + main::ok 203, $@ eq "" ; + my %h ; + my $X ; + eval ' + $X = tie(%h, "SubDB", -Filename => "dbhash.tmp", + -Flags => DB_CREATE, + -Mode => 0640 ); + ' ; + + main::ok 204, $@ eq "" ; + + my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ; + main::ok 205, $@ eq "" ; + main::ok 206, $ret == 7 ; + + my $value = 0; + $ret = eval '$X->db_put("joe", 4) ; $X->db_get("joe", $value) ; return $value' ; + main::ok 207, $@ eq "" ; + main::ok 208, $ret == 10 ; + + $ret = eval ' DB_NEXT eq main::DB_NEXT ' ; + main::ok 209, $@ eq "" ; + main::ok 210, $ret == 1 ; + + $ret = eval '$X->A_new_method("joe") ' ; + main::ok 211, $@ eq "" ; + main::ok 212, $ret eq "[[10]]" ; + + unlink "SubDB.pm", "dbhash.tmp" ; + +} diff --git a/storage/bdb/perl/BerkeleyDB/t/join.t b/storage/bdb/perl/BerkeleyDB/t/join.t new file mode 100644 index 00000000000..ed9b6a269cb --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/join.t @@ -0,0 +1,225 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +if ($BerkeleyDB::db_ver < 2.005002) +{ + print "1..0 # Skip: join needs Berkeley DB 2.5.2 or later\n" ; + exit 0 ; +} + + +print "1..37\n"; + +my $Dfile1 = "dbhash1.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile1, $Dfile2, $Dfile3 ; + +umask(0) ; + +{ + # error cases + my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ; + my %hash1 ; + my $value ; + my $status ; + my $cursor ; + + ok 1, my $db1 = tie %hash1, 'BerkeleyDB::Hash', + -Filename => $Dfile1, + -Flags => DB_CREATE, + -DupCompare => sub { $_[0] lt $_[1] }, + -Property => DB_DUP|DB_DUPSORT ; + + # no cursors supplied + eval '$cursor = $db1->db_join() ;' ; + ok 2, $@ =~ /Usage: \$db->BerkeleyDB::Common::db_join\Q([cursors], flags=0)/; + + # empty list + eval '$cursor = $db1->db_join([]) ;' ; + ok 3, $@ =~ /db_join: No cursors in parameter list/; + + # cursor list, isn't a [] + eval '$cursor = $db1->db_join({}) ;' ; + ok 4, $@ =~ /cursors is not an array reference at/ ; + + eval '$cursor = $db1->db_join(\1) ;' ; + ok 5, $@ =~ /cursors is not an array reference at/ ; + +} + +{ + # test a 2-way & 3-way join + + my $lex = new LexFile $Dfile1, $Dfile2, $Dfile3 ; + my %hash1 ; + my %hash2 ; + my %hash3 ; + my $value ; + my $status ; + + my $home = "./fred" ; + ok 6, my $lexD = new LexDir($home); + ok 7, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN + |DB_INIT_MPOOL; + #|DB_INIT_MPOOL| DB_INIT_LOCK; + ok 8, my $txn = $env->txn_begin() ; + ok 9, my $db1 = tie %hash1, 'BerkeleyDB::Hash', + -Filename => $Dfile1, + -Flags => DB_CREATE, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP|DB_DUPSORT, + -Env => $env, + -Txn => $txn ; + ; + + ok 10, my $db2 = tie %hash2, 'BerkeleyDB::Hash', + -Filename => $Dfile2, + -Flags => DB_CREATE, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP|DB_DUPSORT, + -Env => $env, + -Txn => $txn ; + + ok 11, my $db3 = tie %hash3, 'BerkeleyDB::Btree', + -Filename => $Dfile3, + -Flags => DB_CREATE, + -DupCompare => sub { $_[0] cmp $_[1] }, + -Property => DB_DUP|DB_DUPSORT, + -Env => $env, + -Txn => $txn ; + + + ok 12, addData($db1, qw( apple Convenience + peach Shopway + pear Farmer + raspberry Shopway + strawberry Shopway + gooseberry Farmer + blueberry Farmer + )); + + ok 13, addData($db2, qw( red apple + red raspberry + red strawberry + yellow peach + yellow pear + green gooseberry + blue blueberry)) ; + + ok 14, addData($db3, qw( expensive apple + reasonable raspberry + expensive strawberry + reasonable peach + reasonable pear + expensive gooseberry + reasonable blueberry)) ; + + ok 15, my $cursor2 = $db2->db_cursor() ; + my $k = "red" ; + my $v = "" ; + ok 16, $cursor2->c_get($k, $v, DB_SET) == 0 ; + + # Two way Join + ok 17, my $cursor1 = $db1->db_join([$cursor2]) ; + + my %expected = qw( apple Convenience + raspberry Shopway + strawberry Shopway + ) ; + + # sequence forwards + while ($cursor1->c_get($k, $v) == 0) { + delete $expected{$k} + if defined $expected{$k} && $expected{$k} eq $v ; + #print "[$k] [$v]\n" ; + } + ok 18, keys %expected == 0 ; + ok 19, $cursor1->status() == DB_NOTFOUND ; + + # Three way Join + ok 20, $cursor2 = $db2->db_cursor() ; + $k = "red" ; + $v = "" ; + ok 21, $cursor2->c_get($k, $v, DB_SET) == 0 ; + + ok 22, my $cursor3 = $db3->db_cursor() ; + $k = "expensive" ; + $v = "" ; + ok 23, $cursor3->c_get($k, $v, DB_SET) == 0 ; + ok 24, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ; + + %expected = qw( apple Convenience + strawberry Shopway + ) ; + + # sequence forwards + while ($cursor1->c_get($k, $v) == 0) { + delete $expected{$k} + if defined $expected{$k} && $expected{$k} eq $v ; + #print "[$k] [$v]\n" ; + } + ok 25, keys %expected == 0 ; + ok 26, $cursor1->status() == DB_NOTFOUND ; + + # test DB_JOIN_ITEM + # ################# + ok 27, $cursor2 = $db2->db_cursor() ; + $k = "red" ; + $v = "" ; + ok 28, $cursor2->c_get($k, $v, DB_SET) == 0 ; + + ok 29, $cursor3 = $db3->db_cursor() ; + $k = "expensive" ; + $v = "" ; + ok 30, $cursor3->c_get($k, $v, DB_SET) == 0 ; + ok 31, $cursor1 = $db1->db_join([$cursor2, $cursor3]) ; + + %expected = qw( apple 1 + strawberry 1 + ) ; + + # sequence forwards + $k = "" ; + $v = "" ; + while ($cursor1->c_get($k, $v, DB_JOIN_ITEM) == 0) { + delete $expected{$k} + if defined $expected{$k} ; + #print "[$k]\n" ; + } + ok 32, keys %expected == 0 ; + ok 33, $cursor1->status() == DB_NOTFOUND ; + + ok 34, $cursor1->c_close() == 0 ; + ok 35, $cursor2->c_close() == 0 ; + ok 36, $cursor3->c_close() == 0 ; + + ok 37, ($status = $txn->txn_commit) == 0; + + undef $txn ; + #undef $cursor1; + #undef $cursor2; + #undef $cursor3; + undef $db1 ; + undef $db2 ; + undef $db3 ; + undef $env ; + untie %hash1 ; + untie %hash2 ; + untie %hash3 ; +} +print "# at the end\n"; diff --git a/storage/bdb/perl/BerkeleyDB/t/mldbm.t b/storage/bdb/perl/BerkeleyDB/t/mldbm.t new file mode 100644 index 00000000000..d35f7e15895 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/mldbm.t @@ -0,0 +1,161 @@ +#!/usr/bin/perl -w + +use strict ; + +BEGIN +{ + if ($] < 5.005) { + print "1..0 # This is Perl $], skipping test\n" ; + exit 0 ; + } + + eval { require Data::Dumper ; }; + if ($@) { + print "1..0 # Data::Dumper is not installed on this system.\n"; + exit 0 ; + } + if ($Data::Dumper::VERSION < 2.08) { + print "1..0 # Data::Dumper 2.08 or better required (found $Data::Dumper::VERSION).\n"; + exit 0 ; + } + eval { require MLDBM ; }; + if ($@) { + print "1..0 # MLDBM is not installed on this system.\n"; + exit 0 ; + } +} + +use t::util ; + +print "1..12\n"; + +{ + package BTREE ; + + use BerkeleyDB ; + use MLDBM qw(BerkeleyDB::Btree) ; + use Data::Dumper; + + my $filename = ""; + my $lex = new LexFile $filename; + + $MLDBM::UseDB = "BerkeleyDB::Btree" ; + my %o ; + my $db = tie %o, 'MLDBM', -Filename => $filename, + -Flags => DB_CREATE + or die $!; + ::ok 1, $db ; + ::ok 2, $db->type() == DB_BTREE ; + + my $c = [\'c']; + my $b = {}; + my $a = [1, $b, $c]; + $b->{a} = $a; + $b->{b} = $a->[1]; + $b->{c} = $a->[2]; + @o{qw(a b c)} = ($a, $b, $c); + $o{d} = "{once upon a time}"; + $o{e} = 1024; + $o{f} = 1024.1024; + my $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump; + my $second = <<'EOT'; +$a = [ + 1, + { + a => $a, + b => $a->[1], + c => [ + \'c' + ] + }, + $a->[1]{c} + ]; +$b = { + a => [ + 1, + $b, + [ + \'c' + ] + ], + b => $b, + c => $b->{a}[2] + }; +$c = [ + \'c' + ]; +EOT + + ::ok 3, $first eq $second ; + ::ok 4, $o{d} eq "{once upon a time}" ; + ::ok 5, $o{e} == 1024 ; + ::ok 6, $o{f} eq 1024.1024 ; + +} + +{ + + package HASH ; + + use BerkeleyDB ; + use MLDBM qw(BerkeleyDB::Hash) ; + use Data::Dumper; + + my $filename = ""; + my $lex = new LexFile $filename; + + unlink $filename ; + $MLDBM::UseDB = "BerkeleyDB::Hash" ; + my %o ; + my $db = tie %o, 'MLDBM', -Filename => $filename, + -Flags => DB_CREATE + or die $!; + ::ok 7, $db ; + ::ok 8, $db->type() == DB_HASH ; + + + my $c = [\'c']; + my $b = {}; + my $a = [1, $b, $c]; + $b->{a} = $a; + $b->{b} = $a->[1]; + $b->{c} = $a->[2]; + @o{qw(a b c)} = ($a, $b, $c); + $o{d} = "{once upon a time}"; + $o{e} = 1024; + $o{f} = 1024.1024; + my $first = Data::Dumper->new([@o{qw(a b c)}], [qw(a b c)])->Quotekeys(0)->Dump; + my $second = <<'EOT'; +$a = [ + 1, + { + a => $a, + b => $a->[1], + c => [ + \'c' + ] + }, + $a->[1]{c} + ]; +$b = { + a => [ + 1, + $b, + [ + \'c' + ] + ], + b => $b, + c => $b->{a}[2] + }; +$c = [ + \'c' + ]; +EOT + + ::ok 9, $first eq $second ; + ::ok 10, $o{d} eq "{once upon a time}" ; + ::ok 11, $o{e} == 1024 ; + ::ok 12, $o{f} eq 1024.1024 ; + +} diff --git a/storage/bdb/perl/BerkeleyDB/t/queue.t b/storage/bdb/perl/BerkeleyDB/t/queue.t new file mode 100644 index 00000000000..86add129ca4 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/queue.t @@ -0,0 +1,763 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +BEGIN +{ + if ($BerkeleyDB::db_version < 3.3) { + print "1..0 # Skipping test, Queue needs Berkeley DB 3.3.x or better\n" ; + exit 0 ; + } +} + +print "1..201\n"; + +sub fillout +{ + my $var = shift ; + my $length = shift ; + my $pad = shift || " " ; + my $template = $pad x $length ; + substr($template, 0, length($var)) = $var ; + return $template ; +} + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' $db = new BerkeleyDB::Queue -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $db = new BerkeleyDB::Queue -Bad => 2, -Mode => 0345, -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) / ; + + eval ' $db = new BerkeleyDB::Queue -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' $db = new BerkeleyDB::Queue -Txn => "x" ' ; + ok 4, $@ =~ /^Txn not of type BerkeleyDB::Txn/ ; + + my $obj = bless [], "main" ; + eval ' $db = new BerkeleyDB::Queue -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +# Now check the interface to Queue + +{ + my $lex = new LexFile $Dfile ; + my $rec_len = 10 ; + my $pad = "x" ; + + ok 6, my $db = new BerkeleyDB::Queue -Filename => $Dfile, + -Flags => DB_CREATE, + -Len => $rec_len, + -Pad => $pad; + + # Add a k/v pair + my $value ; + my $status ; + ok 7, $db->db_put(1, "some value") == 0 ; + ok 8, $db->status() == 0 ; + ok 9, $db->db_get(1, $value) == 0 ; + ok 10, $value eq fillout("some value", $rec_len, $pad) ; + ok 11, $db->db_put(2, "value") == 0 ; + ok 12, $db->db_get(2, $value) == 0 ; + ok 13, $value eq fillout("value", $rec_len, $pad) ; + ok 14, $db->db_del(1) == 0 ; + ok 15, ($status = $db->db_get(1, $value)) == DB_KEYEMPTY ; + ok 16, $db->status() == DB_KEYEMPTY ; + ok 17, $db->status() eq $DB_errors{'DB_KEYEMPTY'} ; + + ok 18, ($status = $db->db_get(7, $value)) == DB_NOTFOUND ; + ok 19, $db->status() == DB_NOTFOUND ; + ok 20, $db->status() eq $DB_errors{'DB_NOTFOUND'} ; + + ok 21, $db->db_sync() == 0 ; + + # Check NOOVERWRITE will make put fail when attempting to overwrite + # an existing record. + + ok 22, $db->db_put( 2, 'x', DB_NOOVERWRITE) == DB_KEYEXIST ; + ok 23, $db->status() eq $DB_errors{'DB_KEYEXIST'} ; + ok 24, $db->status() == DB_KEYEXIST ; + + + # check that the value of the key has not been changed by the + # previous test + ok 25, $db->db_get(2, $value) == 0 ; + ok 26, $value eq fillout("value", $rec_len, $pad) ; + + +} + + +{ + # Check simple env works with a array. + # and pad defaults to space + my $lex = new LexFile $Dfile ; + + my $home = "./fred" ; + my $rec_len = 11 ; + ok 27, my $lexD = new LexDir($home); + + ok 28, my $env = new BerkeleyDB::Env -Flags => DB_CREATE|DB_INIT_MPOOL, + -Home => $home ; + ok 29, my $db = new BerkeleyDB::Queue -Filename => $Dfile, + -Env => $env, + -Flags => DB_CREATE, + -Len => $rec_len; + + # Add a k/v pair + my $value ; + ok 30, $db->db_put(1, "some value") == 0 ; + ok 31, $db->db_get(1, $value) == 0 ; + ok 32, $value eq fillout("some value", $rec_len) ; + undef $db ; + undef $env ; +} + + +{ + # cursors + + my $lex = new LexFile $Dfile ; + my @array ; + my ($k, $v) ; + my $rec_len = 5 ; + ok 33, my $db = new BerkeleyDB::Queue -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Len => $rec_len; + + # create some data + my @data = ( + "red" , + "green" , + "blue" , + ) ; + + my $i ; + my %data ; + my $ret = 0 ; + for ($i = 0 ; $i < @data ; ++$i) { + $ret += $db->db_put($i, $data[$i]) ; + $data{$i} = $data[$i] ; + } + ok 34, $ret == 0 ; + + # create the cursor + ok 35, my $cursor = $db->db_cursor() ; + + $k = 0 ; $v = "" ; + my %copy = %data; + my $extras = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { + if ( fillout($copy{$k}, $rec_len) eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + + ok 36, $cursor->status() == DB_NOTFOUND ; + ok 37, $cursor->status() eq $DB_errors{'DB_NOTFOUND'} ; + ok 38, keys %copy == 0 ; + ok 39, $extras == 0 ; + + # sequence backwards + %copy = %data ; + $extras = 0 ; + my $status ; + for ( $status = $cursor->c_get($k, $v, DB_LAST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_PREV)) { + if ( fillout($copy{$k}, $rec_len) eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 40, $status == DB_NOTFOUND ; + ok 41, $status eq $DB_errors{'DB_NOTFOUND'} ; + ok 42, $cursor->status() == $status ; + ok 43, $cursor->status() eq $status ; + ok 44, keys %copy == 0 ; + ok 45, $extras == 0 ; +} + +{ + # Tied Array interface + + my $lex = new LexFile $Dfile ; + my @array ; + my $db ; + my $rec_len = 10 ; + ok 46, $db = tie @array, 'BerkeleyDB::Queue', -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Len => $rec_len; + + ok 47, my $cursor = (tied @array)->db_cursor() ; + # check the database is empty + my $count = 0 ; + my ($k, $v) = (0,"") ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 48, $cursor->status() == DB_NOTFOUND ; + ok 49, $count == 0 ; + + ok 50, @array == 0 ; + + # Add a k/v pair + my $value ; + $array[1] = "some value"; + ok 51, (tied @array)->status() == 0 ; + ok 52, $array[1] eq fillout("some value", $rec_len); + ok 53, defined $array[1]; + ok 54, (tied @array)->status() == 0 ; + ok 55, !defined $array[3]; + ok 56, (tied @array)->status() == DB_NOTFOUND ; + + ok 57, (tied @array)->db_del(1) == 0 ; + ok 58, (tied @array)->status() == 0 ; + ok 59, ! defined $array[1]; + ok 60, (tied @array)->status() == DB_KEYEMPTY ; + + $array[1] = 2 ; + $array[10] = 20 ; + $array[1000] = 2000 ; + + my ($keys, $values) = (0,0); + $count = 0 ; + for ( my $status = $cursor->c_get($k, $v, DB_FIRST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_NEXT)) { + $keys += $k ; + $values += $v ; + ++ $count ; + } + ok 61, $count == 3 ; + ok 62, $keys == 1011 ; + ok 63, $values == 2022 ; + + # unshift isn't allowed +# eval { +# $FA ? unshift @array, "red", "green", "blue" +# : $db->unshift("red", "green", "blue" ) ; +# } ; +# ok 64, $@ =~ /^unshift is unsupported with Queue databases/ ; + $array[0] = "red" ; + $array[1] = "green" ; + $array[2] = "blue" ; + $array[4] = 2 ; + ok 64, $array[0] eq fillout("red", $rec_len) ; + ok 65, $cursor->c_get($k, $v, DB_FIRST) == 0 ; + ok 66, $k == 0 ; + ok 67, $v eq fillout("red", $rec_len) ; + ok 68, $array[1] eq fillout("green", $rec_len) ; + ok 69, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 70, $k == 1 ; + ok 71, $v eq fillout("green", $rec_len) ; + ok 72, $array[2] eq fillout("blue", $rec_len) ; + ok 73, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 74, $k == 2 ; + ok 75, $v eq fillout("blue", $rec_len) ; + ok 76, $array[4] == 2 ; + ok 77, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 78, $k == 4 ; + ok 79, $v == 2 ; + + # shift + ok 80, ($FA ? shift @array : $db->shift()) eq fillout("red", $rec_len) ; + ok 81, ($FA ? shift @array : $db->shift()) eq fillout("green", $rec_len) ; + ok 82, ($FA ? shift @array : $db->shift()) eq fillout("blue", $rec_len) ; + ok 83, ($FA ? shift @array : $db->shift()) == 2 ; + + # push + $FA ? push @array, "the", "end" + : $db->push("the", "end") ; + ok 84, $cursor->c_get($k, $v, DB_LAST) == 0 ; + ok 85, $k == 1002 ; + ok 86, $v eq fillout("end", $rec_len) ; + ok 87, $cursor->c_get($k, $v, DB_PREV) == 0 ; + ok 88, $k == 1001 ; + ok 89, $v eq fillout("the", $rec_len) ; + ok 90, $cursor->c_get($k, $v, DB_PREV) == 0 ; + ok 91, $k == 1000 ; + ok 92, $v == 2000 ; + + # pop + ok 93, ( $FA ? pop @array : $db->pop ) eq fillout("end", $rec_len) ; + ok 94, ( $FA ? pop @array : $db->pop ) eq fillout("the", $rec_len) ; + ok 95, ( $FA ? pop @array : $db->pop ) == 2000 ; + + # now clear the array + $FA ? @array = () + : $db->clear() ; + ok 96, $cursor->c_get($k, $v, DB_FIRST) == DB_NOTFOUND ; + + undef $cursor ; + undef $db ; + untie @array ; +} + +{ + # in-memory file + + my @array ; + my $fd ; + my $value ; + my $rec_len = 15 ; + ok 97, my $db = tie @array, 'BerkeleyDB::Queue', + -Len => $rec_len; + + ok 98, $db->db_put(1, "some value") == 0 ; + ok 99, $db->db_get(1, $value) == 0 ; + ok 100, $value eq fillout("some value", $rec_len) ; + +} + +{ + # partial + # check works via API + + my $lex = new LexFile $Dfile ; + my $value ; + my $rec_len = 8 ; + ok 101, my $db = new BerkeleyDB::Queue -Filename => $Dfile, + -Flags => DB_CREATE , + -Len => $rec_len, + -Pad => " " ; + + # create some data + my @data = ( + "", + "boat", + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = 0 ; $i < @data ; ++$i) { + my $r = $db->db_put($i, $data[$i]) ; + $ret += $r ; + } + ok 102, $ret == 0 ; + + # do a partial get + my ($pon, $off, $len) = $db->partial_set(0,2) ; + ok 103, ! $pon && $off == 0 && $len == 0 ; + ok 104, $db->db_get(1, $value) == 0 && $value eq "bo" ; + ok 105, $db->db_get(2, $value) == 0 && $value eq "ho" ; + ok 106, $db->db_get(3, $value) == 0 && $value eq "se" ; + + # do a partial get, off end of data + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 107, $pon ; + ok 108, $off == 0 ; + ok 109, $len == 2 ; + ok 110, $db->db_get(1, $value) == 0 && $value eq fillout("t", 2) ; + ok 111, $db->db_get(2, $value) == 0 && $value eq "se" ; + ok 112, $db->db_get(3, $value) == 0 && $value eq " " ; + + # switch of partial mode + ($pon, $off, $len) = $db->partial_clear() ; + ok 113, $pon ; + ok 114, $off == 3 ; + ok 115, $len == 2 ; + ok 116, $db->db_get(1, $value) == 0 && $value eq fillout("boat", $rec_len) ; + ok 117, $db->db_get(2, $value) == 0 && $value eq fillout("house", $rec_len) ; + ok 118, $db->db_get(3, $value) == 0 && $value eq fillout("sea", $rec_len) ; + + # now partial put + $db->partial_set(0,2) ; + ok 119, $db->db_put(1, "") != 0 ; + ok 120, $db->db_put(2, "AB") == 0 ; + ok 121, $db->db_put(3, "XY") == 0 ; + ok 122, $db->db_put(4, "KLM") != 0 ; + ok 123, $db->db_put(4, "KL") == 0 ; + + ($pon, $off, $len) = $db->partial_clear() ; + ok 124, $pon ; + ok 125, $off == 0 ; + ok 126, $len == 2 ; + ok 127, $db->db_get(1, $value) == 0 && $value eq fillout("boat", $rec_len) ; + ok 128, $db->db_get(2, $value) == 0 && $value eq fillout("ABuse", $rec_len) ; + ok 129, $db->db_get(3, $value) == 0 && $value eq fillout("XYa", $rec_len) ; + ok 130, $db->db_get(4, $value) == 0 && $value eq fillout("KL", $rec_len) ; + + # now partial put + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 131, ! $pon ; + ok 132, $off == 0 ; + ok 133, $len == 0 ; + ok 134, $db->db_put(1, "PP") == 0 ; + ok 135, $db->db_put(2, "Q") != 0 ; + ok 136, $db->db_put(3, "XY") == 0 ; + ok 137, $db->db_put(4, "TU") == 0 ; + + $db->partial_clear() ; + ok 138, $db->db_get(1, $value) == 0 && $value eq fillout("boaPP", $rec_len) ; + ok 139, $db->db_get(2, $value) == 0 && $value eq fillout("ABuse",$rec_len) ; + ok 140, $db->db_get(3, $value) == 0 && $value eq fillout("XYaXY", $rec_len) ; + ok 141, $db->db_get(4, $value) == 0 && $value eq fillout("KL TU", $rec_len) ; +} + +{ + # partial + # check works via tied array + + my $lex = new LexFile $Dfile ; + my @array ; + my $value ; + my $rec_len = 8 ; + ok 142, my $db = tie @array, 'BerkeleyDB::Queue', -Filename => $Dfile, + -Flags => DB_CREATE , + -Len => $rec_len, + -Pad => " " ; + + # create some data + my @data = ( + "", + "boat", + "house", + "sea", + ) ; + + my $i ; + my $status = 0 ; + for ($i = 1 ; $i < @data ; ++$i) { + $array[$i] = $data[$i] ; + $status += $db->status() ; + } + + ok 143, $status == 0 ; + + # do a partial get + $db->partial_set(0,2) ; + ok 144, $array[1] eq fillout("bo", 2) ; + ok 145, $array[2] eq fillout("ho", 2) ; + ok 146, $array[3] eq fillout("se", 2) ; + + # do a partial get, off end of data + $db->partial_set(3,2) ; + ok 147, $array[1] eq fillout("t", 2) ; + ok 148, $array[2] eq fillout("se", 2) ; + ok 149, $array[3] eq fillout("", 2) ; + + # switch of partial mode + $db->partial_clear() ; + ok 150, $array[1] eq fillout("boat", $rec_len) ; + ok 151, $array[2] eq fillout("house", $rec_len) ; + ok 152, $array[3] eq fillout("sea", $rec_len) ; + + # now partial put + $db->partial_set(0,2) ; + $array[1] = "" ; + ok 153, $db->status() != 0 ; + $array[2] = "AB" ; + ok 154, $db->status() == 0 ; + $array[3] = "XY" ; + ok 155, $db->status() == 0 ; + $array[4] = "KL" ; + ok 156, $db->status() == 0 ; + + $db->partial_clear() ; + ok 157, $array[1] eq fillout("boat", $rec_len) ; + ok 158, $array[2] eq fillout("ABuse", $rec_len) ; + ok 159, $array[3] eq fillout("XYa", $rec_len) ; + ok 160, $array[4] eq fillout("KL", $rec_len) ; + + # now partial put + $db->partial_set(3,2) ; + $array[1] = "PP" ; + ok 161, $db->status() == 0 ; + $array[2] = "Q" ; + ok 162, $db->status() != 0 ; + $array[3] = "XY" ; + ok 163, $db->status() == 0 ; + $array[4] = "TU" ; + ok 164, $db->status() == 0 ; + + $db->partial_clear() ; + ok 165, $array[1] eq fillout("boaPP", $rec_len) ; + ok 166, $array[2] eq fillout("ABuse", $rec_len) ; + ok 167, $array[3] eq fillout("XYaXY", $rec_len) ; + ok 168, $array[4] eq fillout("KL TU", $rec_len) ; +} + +{ + # transaction + + my $lex = new LexFile $Dfile ; + my @array ; + my $value ; + + my $home = "./fred" ; + ok 169, my $lexD = new LexDir($home); + my $rec_len = 9 ; + ok 170, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 171, my $txn = $env->txn_begin() ; + ok 172, my $db1 = tie @array, 'BerkeleyDB::Queue', + -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn , + -Len => $rec_len, + -Pad => " " ; + + + ok 173, $txn->txn_commit() == 0 ; + ok 174, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my @data = ( + "boat", + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = 0 ; $i < @data ; ++$i) { + $ret += $db1->db_put($i, $data[$i]) ; + } + ok 175, $ret == 0 ; + + # should be able to see all the records + + ok 176, my $cursor = $db1->db_cursor() ; + my ($k, $v) = (0, "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 177, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 178, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 179, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 180, $count == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie @array ; +} + + +{ + # db_stat + + my $lex = new LexFile $Dfile ; + my $recs = ($BerkeleyDB::db_version >= 3.1 ? "qs_ndata" : "qs_nrecs") ; + my @array ; + my ($k, $v) ; + my $rec_len = 7 ; + ok 181, my $db = new BerkeleyDB::Queue -Filename => $Dfile, + -Flags => DB_CREATE, + -Pagesize => 4 * 1024, + -Len => $rec_len, + -Pad => " " + ; + + my $ref = $db->db_stat() ; + ok 182, $ref->{$recs} == 0; + ok 183, $ref->{'qs_pagesize'} == 4 * 1024; + + # create some data + my @data = ( + 2, + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = $db->ArrayOffset ; @data ; ++$i) { + $ret += $db->db_put($i, shift @data) ; + } + ok 184, $ret == 0 ; + + $ref = $db->db_stat() ; + ok 185, $ref->{$recs} == 3; +} + +{ + # sub-class test + + package Another ; + + use strict ; + + open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; + print FILE <<'EOM' ; + + package SubDB ; + + use strict ; + use vars qw( @ISA @EXPORT) ; + + require Exporter ; + use BerkeleyDB; + @ISA=qw(BerkeleyDB::Queue); + @EXPORT = @BerkeleyDB::EXPORT ; + + sub db_put { + my $self = shift ; + my $key = shift ; + my $value = shift ; + $self->SUPER::db_put($key, $value * 3) ; + } + + sub db_get { + my $self = shift ; + $self->SUPER::db_get($_[0], $_[1]) ; + $_[1] -= 2 ; + } + + sub A_new_method + { + my $self = shift ; + my $key = shift ; + my $value = $self->FETCH($key) ; + return "[[$value]]" ; + } + + 1 ; +EOM + + close FILE ; + + BEGIN { push @INC, '.'; } + eval 'use SubDB ; '; + main::ok 186, $@ eq "" ; + my @h ; + my $X ; + my $rec_len = 34 ; + eval ' + $X = tie(@h, "SubDB", -Filename => "dbqueue.tmp", + -Flags => DB_CREATE, + -Mode => 0640 , + -Len => $rec_len, + -Pad => " " + ); + ' ; + + main::ok 187, $@ eq "" ; + + my $ret = eval '$h[1] = 3 ; return $h[1] ' ; + main::ok 188, $@ eq "" ; + main::ok 189, $ret == 7 ; + + my $value = 0; + $ret = eval '$X->db_put(1, 4) ; $X->db_get(1, $value) ; return $value' ; + main::ok 190, $@ eq "" ; + main::ok 191, $ret == 10 ; + + $ret = eval ' DB_NEXT eq main::DB_NEXT ' ; + main::ok 192, $@ eq "" ; + main::ok 193, $ret == 1 ; + + $ret = eval '$X->A_new_method(1) ' ; + main::ok 194, $@ eq "" ; + main::ok 195, $ret eq "[[10]]" ; + + undef $X ; + untie @h ; + unlink "SubDB.pm", "dbqueue.tmp" ; + +} + +{ + # DB_APPEND + + my $lex = new LexFile $Dfile; + my @array ; + my $value ; + my $rec_len = 21 ; + ok 196, my $db = tie @array, 'BerkeleyDB::Queue', + -Filename => $Dfile, + -Flags => DB_CREATE , + -Len => $rec_len, + -Pad => " " ; + + # create a few records + $array[1] = "def" ; + $array[3] = "ghi" ; + + my $k = 0 ; + ok 197, $db->db_put($k, "fred", DB_APPEND) == 0 ; + ok 198, $k == 4 ; + ok 199, $array[4] eq fillout("fred", $rec_len) ; + + undef $db ; + untie @array ; +} + +{ + # 23 Sept 2001 -- push into an empty array + my $lex = new LexFile $Dfile ; + my @array ; + my $db ; + my $rec_len = 21 ; + ok 200, $db = tie @array, 'BerkeleyDB::Queue', + -Flags => DB_CREATE , + -ArrayBase => 0, + -Len => $rec_len, + -Pad => " " , + -Filename => $Dfile ; + $FA ? push @array, "first" + : $db->push("first") ; + + ok 201, ($FA ? pop @array : $db->pop()) eq fillout("first", $rec_len) ; + + undef $db; + untie @array ; + +} + +__END__ + + +# TODO +# +# DB_DELIMETER DB_FIXEDLEN DB_PAD DB_SNAPSHOT with partial records diff --git a/storage/bdb/perl/BerkeleyDB/t/recno.t b/storage/bdb/perl/BerkeleyDB/t/recno.t new file mode 100644 index 00000000000..64b1803f736 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/recno.t @@ -0,0 +1,913 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..226\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' $db = new BerkeleyDB::Recno -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $db = new BerkeleyDB::Recno -Bad => 2, -Mode => 0345, -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) / ; + + eval ' $db = new BerkeleyDB::Recno -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' $db = new BerkeleyDB::Recno -Txn => "x" ' ; + ok 4, $@ =~ /^Txn not of type BerkeleyDB::Txn/ ; + + my $obj = bless [], "main" ; + eval ' $db = new BerkeleyDB::Recno -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +# Now check the interface to Recno + +{ + my $lex = new LexFile $Dfile ; + + ok 6, my $db = new BerkeleyDB::Recno -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + my $status ; + ok 7, $db->db_put(1, "some value") == 0 ; + ok 8, $db->status() == 0 ; + ok 9, $db->db_get(1, $value) == 0 ; + ok 10, $value eq "some value" ; + ok 11, $db->db_put(2, "value") == 0 ; + ok 12, $db->db_get(2, $value) == 0 ; + ok 13, $value eq "value" ; + ok 14, $db->db_del(1) == 0 ; + ok 15, ($status = $db->db_get(1, $value)) == DB_KEYEMPTY ; + ok 16, $db->status() == DB_KEYEMPTY ; + ok 17, $db->status() eq $DB_errors{'DB_KEYEMPTY'} ; + + ok 18, ($status = $db->db_get(7, $value)) == DB_NOTFOUND ; + ok 19, $db->status() == DB_NOTFOUND ; + ok 20, $db->status() eq $DB_errors{'DB_NOTFOUND'} ; + + ok 21, $db->db_sync() == 0 ; + + # Check NOOVERWRITE will make put fail when attempting to overwrite + # an existing record. + + ok 22, $db->db_put( 2, 'x', DB_NOOVERWRITE) == DB_KEYEXIST ; + ok 23, $db->status() eq $DB_errors{'DB_KEYEXIST'} ; + ok 24, $db->status() == DB_KEYEXIST ; + + + # check that the value of the key has not been changed by the + # previous test + ok 25, $db->db_get(2, $value) == 0 ; + ok 26, $value eq "value" ; + + +} + + +{ + # Check simple env works with a array. + my $lex = new LexFile $Dfile ; + + my $home = "./fred" ; + ok 27, my $lexD = new LexDir($home); + + ok 28, my $env = new BerkeleyDB::Env -Flags => DB_CREATE|DB_INIT_MPOOL, + -Home => $home ; + + ok 29, my $db = new BerkeleyDB::Recno -Filename => $Dfile, + -Env => $env, + -Flags => DB_CREATE ; + + # Add a k/v pair + my $value ; + ok 30, $db->db_put(1, "some value") == 0 ; + ok 31, $db->db_get(1, $value) == 0 ; + ok 32, $value eq "some value" ; + undef $db ; + undef $env ; +} + + +{ + # cursors + + my $lex = new LexFile $Dfile ; + my @array ; + my ($k, $v) ; + ok 33, my $db = new BerkeleyDB::Recno -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE ; + + # create some data + my @data = ( + "red" , + "green" , + "blue" , + ) ; + + my $i ; + my %data ; + my $ret = 0 ; + for ($i = 0 ; $i < @data ; ++$i) { + $ret += $db->db_put($i, $data[$i]) ; + $data{$i} = $data[$i] ; + } + ok 34, $ret == 0 ; + + # create the cursor + ok 35, my $cursor = $db->db_cursor() ; + + $k = 0 ; $v = "" ; + my %copy = %data; + my $extras = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + + ok 36, $cursor->status() == DB_NOTFOUND ; + ok 37, $cursor->status() eq $DB_errors{'DB_NOTFOUND'} ; + ok 38, keys %copy == 0 ; + ok 39, $extras == 0 ; + + # sequence backwards + %copy = %data ; + $extras = 0 ; + my $status ; + for ( $status = $cursor->c_get($k, $v, DB_LAST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_PREV)) { + if ( $copy{$k} eq $v ) + { delete $copy{$k} } + else + { ++ $extras } + } + ok 40, $status == DB_NOTFOUND ; + ok 41, $status eq $DB_errors{'DB_NOTFOUND'} ; + ok 42, $cursor->status() == $status ; + ok 43, $cursor->status() eq $status ; + ok 44, keys %copy == 0 ; + ok 45, $extras == 0 ; +} + +{ + # Tied Array interface + + + my $lex = new LexFile $Dfile ; + my @array ; + my $db ; + ok 46, $db = tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -Property => DB_RENUMBER, + -ArrayBase => 0, + -Flags => DB_CREATE ; + + ok 47, my $cursor = (tied @array)->db_cursor() ; + # check the database is empty + my $count = 0 ; + my ($k, $v) = (0,"") ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 48, $cursor->status() == DB_NOTFOUND ; + ok 49, $count == 0 ; + + ok 50, @array == 0 ; + + # Add a k/v pair + my $value ; + $array[1] = "some value"; + ok 51, (tied @array)->status() == 0 ; + ok 52, $array[1] eq "some value"; + ok 53, defined $array[1]; + ok 54, (tied @array)->status() == 0 ; + ok 55, !defined $array[3]; + ok 56, (tied @array)->status() == DB_NOTFOUND ; + + ok 57, (tied @array)->db_del(1) == 0 ; + ok 58, (tied @array)->status() == 0 ; + ok 59, ! defined $array[1]; + ok 60, (tied @array)->status() == DB_NOTFOUND ; + + $array[1] = 2 ; + $array[10] = 20 ; + $array[1000] = 2000 ; + + my ($keys, $values) = (0,0); + $count = 0 ; + for ( my $status = $cursor->c_get($k, $v, DB_FIRST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_NEXT)) { + $keys += $k ; + $values += $v ; + ++ $count ; + } + ok 61, $count == 3 ; + ok 62, $keys == 1011 ; + ok 63, $values == 2022 ; + + # unshift + $FA ? unshift @array, "red", "green", "blue" + : $db->unshift("red", "green", "blue" ) ; + ok 64, $array[1] eq "red" ; + ok 65, $cursor->c_get($k, $v, DB_FIRST) == 0 ; + ok 66, $k == 1 ; + ok 67, $v eq "red" ; + ok 68, $array[2] eq "green" ; + ok 69, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 70, $k == 2 ; + ok 71, $v eq "green" ; + ok 72, $array[3] eq "blue" ; + ok 73, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 74, $k == 3 ; + ok 75, $v eq "blue" ; + ok 76, $array[4] == 2 ; + ok 77, $cursor->c_get($k, $v, DB_NEXT) == 0 ; + ok 78, $k == 4 ; + ok 79, $v == 2 ; + + # shift + ok 80, ($FA ? shift @array : $db->shift()) eq "red" ; + ok 81, ($FA ? shift @array : $db->shift()) eq "green" ; + ok 82, ($FA ? shift @array : $db->shift()) eq "blue" ; + ok 83, ($FA ? shift @array : $db->shift()) == 2 ; + + # push + $FA ? push @array, "the", "end" + : $db->push("the", "end") ; + ok 84, $cursor->c_get($k, $v, DB_LAST) == 0 ; + ok 85, $k == 1001 ; + ok 86, $v eq "end" ; + ok 87, $cursor->c_get($k, $v, DB_PREV) == 0 ; + ok 88, $k == 1000 ; + ok 89, $v eq "the" ; + ok 90, $cursor->c_get($k, $v, DB_PREV) == 0 ; + ok 91, $k == 999 ; + ok 92, $v == 2000 ; + + # pop + ok 93, ( $FA ? pop @array : $db->pop ) eq "end" ; + ok 94, ( $FA ? pop @array : $db->pop ) eq "the" ; + ok 95, ( $FA ? pop @array : $db->pop ) == 2000 ; + + # now clear the array + $FA ? @array = () + : $db->clear() ; + ok 96, $cursor->c_get($k, $v, DB_FIRST) == DB_NOTFOUND ; + + undef $cursor ; + undef $db ; + untie @array ; +} + +{ + # in-memory file + + my @array ; + my $fd ; + my $value ; + ok 97, my $db = tie @array, 'BerkeleyDB::Recno' ; + + ok 98, $db->db_put(1, "some value") == 0 ; + ok 99, $db->db_get(1, $value) == 0 ; + ok 100, $value eq "some value" ; + +} + +{ + # partial + # check works via API + + my $lex = new LexFile $Dfile ; + my $value ; + ok 101, my $db = new BerkeleyDB::Recno, -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my @data = ( + "", + "boat", + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = 1 ; $i < @data ; ++$i) { + $ret += $db->db_put($i, $data[$i]) ; + } + ok 102, $ret == 0 ; + + + # do a partial get + my ($pon, $off, $len) = $db->partial_set(0,2) ; + ok 103, ! $pon && $off == 0 && $len == 0 ; + ok 104, $db->db_get(1, $value) == 0 && $value eq "bo" ; + ok 105, $db->db_get(2, $value) == 0 && $value eq "ho" ; + ok 106, $db->db_get(3, $value) == 0 && $value eq "se" ; + + # do a partial get, off end of data + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 107, $pon ; + ok 108, $off == 0 ; + ok 109, $len == 2 ; + ok 110, $db->db_get(1, $value) == 0 && $value eq "t" ; + ok 111, $db->db_get(2, $value) == 0 && $value eq "se" ; + ok 112, $db->db_get(3, $value) == 0 && $value eq "" ; + + # switch of partial mode + ($pon, $off, $len) = $db->partial_clear() ; + ok 113, $pon ; + ok 114, $off == 3 ; + ok 115, $len == 2 ; + ok 116, $db->db_get(1, $value) == 0 && $value eq "boat" ; + ok 117, $db->db_get(2, $value) == 0 && $value eq "house" ; + ok 118, $db->db_get(3, $value) == 0 && $value eq "sea" ; + + # now partial put + $db->partial_set(0,2) ; + ok 119, $db->db_put(1, "") == 0 ; + ok 120, $db->db_put(2, "AB") == 0 ; + ok 121, $db->db_put(3, "XYZ") == 0 ; + ok 122, $db->db_put(4, "KLM") == 0 ; + + ($pon, $off, $len) = $db->partial_clear() ; + ok 123, $pon ; + ok 124, $off == 0 ; + ok 125, $len == 2 ; + ok 126, $db->db_get(1, $value) == 0 && $value eq "at" ; + ok 127, $db->db_get(2, $value) == 0 && $value eq "ABuse" ; + ok 128, $db->db_get(3, $value) == 0 && $value eq "XYZa" ; + ok 129, $db->db_get(4, $value) == 0 && $value eq "KLM" ; + + # now partial put + ($pon, $off, $len) = $db->partial_set(3,2) ; + ok 130, ! $pon ; + ok 131, $off == 0 ; + ok 132, $len == 0 ; + ok 133, $db->db_put(1, "PPP") == 0 ; + ok 134, $db->db_put(2, "Q") == 0 ; + ok 135, $db->db_put(3, "XYZ") == 0 ; + ok 136, $db->db_put(4, "TU") == 0 ; + + $db->partial_clear() ; + ok 137, $db->db_get(1, $value) == 0 && $value eq "at\0PPP" ; + ok 138, $db->db_get(2, $value) == 0 && $value eq "ABuQ" ; + ok 139, $db->db_get(3, $value) == 0 && $value eq "XYZXYZ" ; + ok 140, $db->db_get(4, $value) == 0 && $value eq "KLMTU" ; +} + +{ + # partial + # check works via tied array + + my $lex = new LexFile $Dfile ; + my @array ; + my $value ; + ok 141, my $db = tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create some data + my @data = ( + "", + "boat", + "house", + "sea", + ) ; + + my $i ; + for ($i = 1 ; $i < @data ; ++$i) { + $array[$i] = $data[$i] ; + } + + + # do a partial get + $db->partial_set(0,2) ; + ok 142, $array[1] eq "bo" ; + ok 143, $array[2] eq "ho" ; + ok 144, $array[3] eq "se" ; + + # do a partial get, off end of data + $db->partial_set(3,2) ; + ok 145, $array[1] eq "t" ; + ok 146, $array[2] eq "se" ; + ok 147, $array[3] eq "" ; + + # switch of partial mode + $db->partial_clear() ; + ok 148, $array[1] eq "boat" ; + ok 149, $array[2] eq "house" ; + ok 150, $array[3] eq "sea" ; + + # now partial put + $db->partial_set(0,2) ; + ok 151, $array[1] = "" ; + ok 152, $array[2] = "AB" ; + ok 153, $array[3] = "XYZ" ; + ok 154, $array[4] = "KLM" ; + + $db->partial_clear() ; + ok 155, $array[1] eq "at" ; + ok 156, $array[2] eq "ABuse" ; + ok 157, $array[3] eq "XYZa" ; + ok 158, $array[4] eq "KLM" ; + + # now partial put + $db->partial_set(3,2) ; + ok 159, $array[1] = "PPP" ; + ok 160, $array[2] = "Q" ; + ok 161, $array[3] = "XYZ" ; + ok 162, $array[4] = "TU" ; + + $db->partial_clear() ; + ok 163, $array[1] eq "at\0PPP" ; + ok 164, $array[2] eq "ABuQ" ; + ok 165, $array[3] eq "XYZXYZ" ; + ok 166, $array[4] eq "KLMTU" ; +} + +{ + # transaction + + my $lex = new LexFile $Dfile ; + my @array ; + my $value ; + + my $home = "./fred" ; + ok 167, my $lexD = new LexDir($home); + ok 168, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 169, my $txn = $env->txn_begin() ; + ok 170, my $db1 = tie @array, 'BerkeleyDB::Recno', + -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + + ok 171, $txn->txn_commit() == 0 ; + ok 172, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my @data = ( + "boat", + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = 0 ; $i < @data ; ++$i) { + $ret += $db1->db_put($i, $data[$i]) ; + } + ok 173, $ret == 0 ; + + # should be able to see all the records + + ok 174, my $cursor = $db1->db_cursor() ; + my ($k, $v) = (0, "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 175, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 176, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 177, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 178, $count == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie @array ; +} + + +{ + # db_stat + + my $lex = new LexFile $Dfile ; + my $recs = ($BerkeleyDB::db_version >= 3.1 ? "bt_ndata" : "bt_nrecs") ; + my @array ; + my ($k, $v) ; + ok 179, my $db = new BerkeleyDB::Recno -Filename => $Dfile, + -Flags => DB_CREATE, + -Pagesize => 4 * 1024, + ; + + my $ref = $db->db_stat() ; + ok 180, $ref->{$recs} == 0; + ok 181, $ref->{'bt_pagesize'} == 4 * 1024; + + # create some data + my @data = ( + 2, + "house", + "sea", + ) ; + + my $ret = 0 ; + my $i ; + for ($i = $db->ArrayOffset ; @data ; ++$i) { + $ret += $db->db_put($i, shift @data) ; + } + ok 182, $ret == 0 ; + + $ref = $db->db_stat() ; + ok 183, $ref->{$recs} == 3; +} + +{ + # sub-class test + + package Another ; + + use strict ; + + open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ; + print FILE <<'EOM' ; + + package SubDB ; + + use strict ; + use vars qw( @ISA @EXPORT) ; + + require Exporter ; + use BerkeleyDB; + @ISA=qw(BerkeleyDB::Recno); + @EXPORT = @BerkeleyDB::EXPORT ; + + sub db_put { + my $self = shift ; + my $key = shift ; + my $value = shift ; + $self->SUPER::db_put($key, $value * 3) ; + } + + sub db_get { + my $self = shift ; + $self->SUPER::db_get($_[0], $_[1]) ; + $_[1] -= 2 ; + } + + sub A_new_method + { + my $self = shift ; + my $key = shift ; + my $value = $self->FETCH($key) ; + return "[[$value]]" ; + } + + 1 ; +EOM + + close FILE ; + + BEGIN { push @INC, '.'; } + eval 'use SubDB ; '; + main::ok 184, $@ eq "" ; + my @h ; + my $X ; + eval ' + $X = tie(@h, "SubDB", -Filename => "dbrecno.tmp", + -Flags => DB_CREATE, + -Mode => 0640 ); + ' ; + + main::ok 185, $@ eq "" ; + + my $ret = eval '$h[1] = 3 ; return $h[1] ' ; + main::ok 186, $@ eq "" ; + main::ok 187, $ret == 7 ; + + my $value = 0; + $ret = eval '$X->db_put(1, 4) ; $X->db_get(1, $value) ; return $value' ; + main::ok 188, $@ eq "" ; + main::ok 189, $ret == 10 ; + + $ret = eval ' DB_NEXT eq main::DB_NEXT ' ; + main::ok 190, $@ eq "" ; + main::ok 191, $ret == 1 ; + + $ret = eval '$X->A_new_method(1) ' ; + main::ok 192, $@ eq "" ; + main::ok 193, $ret eq "[[10]]" ; + + undef $X; + untie @h; + unlink "SubDB.pm", "dbrecno.tmp" ; + +} + +{ + # variable length records, DB_DELIMETER -- defaults to \n + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 194, tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Source => $Dfile2 ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 195, $x eq "abc\ndef\n\nghi\n" ; +} + +{ + # variable length records, change DB_DELIMETER + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 196, tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Source => $Dfile2 , + -Delim => "-"; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 197, $x eq "abc-def--ghi-"; +} + +{ + # fixed length records, default DB_PAD + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 198, tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Len => 5, + -Source => $Dfile2 ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 199, $x eq "abc def ghi " ; +} + +{ + # fixed length records, change Pad + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 200, tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -ArrayBase => 0, + -Flags => DB_CREATE , + -Len => 5, + -Pad => "-", + -Source => $Dfile2 ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 201, $x eq "abc--def-------ghi--" ; +} + +{ + # DB_RENUMBER + + my $lex = new LexFile $Dfile; + my @array ; + my $value ; + ok 202, my $db = tie @array, 'BerkeleyDB::Recno', -Filename => $Dfile, + -Property => DB_RENUMBER, + -ArrayBase => 0, + -Flags => DB_CREATE ; + # create a few records + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + + ok 203, my ($length, $joined) = joiner($db, "|") ; + ok 204, $length == 3 ; + ok 205, $joined eq "abc|def|ghi"; + + ok 206, $db->db_del(1) == 0 ; + ok 207, ($length, $joined) = joiner($db, "|") ; + ok 208, $length == 2 ; + ok 209, $joined eq "abc|ghi"; + + undef $db ; + untie @array ; + +} + +{ + # DB_APPEND + + my $lex = new LexFile $Dfile; + my @array ; + my $value ; + ok 210, my $db = tie @array, 'BerkeleyDB::Recno', + -Filename => $Dfile, + -Flags => DB_CREATE ; + + # create a few records + $array[1] = "def" ; + $array[3] = "ghi" ; + + my $k = 0 ; + ok 211, $db->db_put($k, "fred", DB_APPEND) == 0 ; + ok 212, $k == 4 ; + + undef $db ; + untie @array ; +} + +{ + # in-memory Btree with an associated text file + + my $lex = new LexFile $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 213, tie @array, 'BerkeleyDB::Recno', -Source => $Dfile2 , + -ArrayBase => 0, + -Property => DB_RENUMBER, + -Flags => DB_CREATE ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 214, $x eq "abc\ndef\n\nghi\n" ; +} + +{ + # in-memory, variable length records, change DB_DELIMETER + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 215, tie @array, 'BerkeleyDB::Recno', + -ArrayBase => 0, + -Flags => DB_CREATE , + -Source => $Dfile2 , + -Property => DB_RENUMBER, + -Delim => "-"; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 216, $x eq "abc-def--ghi-"; +} + +{ + # in-memory, fixed length records, default DB_PAD + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 217, tie @array, 'BerkeleyDB::Recno', -ArrayBase => 0, + -Flags => DB_CREATE , + -Property => DB_RENUMBER, + -Len => 5, + -Source => $Dfile2 ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 218, $x eq "abc def ghi " ; +} + +{ + # in-memory, fixed length records, change Pad + + my $lex = new LexFile $Dfile, $Dfile2 ; + touch $Dfile2 ; + my @array ; + my $value ; + ok 219, tie @array, 'BerkeleyDB::Recno', + -ArrayBase => 0, + -Flags => DB_CREATE , + -Property => DB_RENUMBER, + -Len => 5, + -Pad => "-", + -Source => $Dfile2 ; + $array[0] = "abc" ; + $array[1] = "def" ; + $array[3] = "ghi" ; + untie @array ; + + my $x = docat($Dfile2) ; + ok 220, $x eq "abc--def-------ghi--" ; +} + +{ + # 23 Sept 2001 -- push into an empty array + my $lex = new LexFile $Dfile ; + my @array ; + my $db ; + ok 221, $db = tie @array, 'BerkeleyDB::Recno', + -ArrayBase => 0, + -Flags => DB_CREATE , + -Property => DB_RENUMBER, + -Filename => $Dfile ; + $FA ? push @array, "first" + : $db->push("first") ; + + ok 222, $array[0] eq "first" ; + ok 223, $FA ? pop @array : $db->pop() eq "first" ; + + undef $db; + untie @array ; + +} + +{ + # 23 Sept 2001 -- unshift into an empty array + my $lex = new LexFile $Dfile ; + my @array ; + my $db ; + ok 224, $db = tie @array, 'BerkeleyDB::Recno', + -ArrayBase => 0, + -Flags => DB_CREATE , + -Property => DB_RENUMBER, + -Filename => $Dfile ; + $FA ? unshift @array, "first" + : $db->unshift("first") ; + + ok 225, $array[0] eq "first" ; + ok 226, ($FA ? shift @array : $db->shift()) eq "first" ; + + undef $db; + untie @array ; + +} +__END__ + + +# TODO +# +# DB_DELIMETER DB_FIXEDLEN DB_PAD DB_SNAPSHOT with partial records diff --git a/storage/bdb/perl/BerkeleyDB/t/strict.t b/storage/bdb/perl/BerkeleyDB/t/strict.t new file mode 100644 index 00000000000..ab41d44cb41 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/strict.t @@ -0,0 +1,174 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..44\n"; + +my $Dfile = "dbhash.tmp"; +my $home = "./fred" ; + +umask(0); + +{ + # closing a database & an environment in the correct order. + my $lex = new LexFile $Dfile ; + my %hash ; + my $status ; + + ok 1, my $lexD = new LexDir($home); + ok 2, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + + ok 3, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env; + + ok 4, $db1->db_close() == 0 ; + + eval { $status = $env->db_appexit() ; } ; + ok 5, $status == 0 ; + ok 6, $@ eq "" ; + #print "[$@]\n" ; + +} + +{ + # closing an environment with an open database + my $lex = new LexFile $Dfile ; + my %hash ; + + ok 7, my $lexD = new LexDir($home); + ok 8, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + + ok 9, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env; + + eval { $env->db_appexit() ; } ; + ok 10, $@ =~ /BerkeleyDB Aborting: attempted to close an environment with 1 open database/ ; + #print "[$@]\n" ; + + undef $db1 ; + untie %hash ; + undef $env ; +} + +{ + # closing a transaction & a database + my $lex = new LexFile $Dfile ; + my %hash ; + my $status ; + + ok 11, my $lexD = new LexDir($home); + ok 12, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + + ok 13, my $txn = $env->txn_begin() ; + ok 14, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + ok 15, $txn->txn_commit() == 0 ; + eval { $status = $db->db_close() ; } ; + ok 16, $status == 0 ; + ok 17, $@ eq "" ; + #print "[$@]\n" ; + eval { $status = $env->db_appexit() ; } ; + ok 18, $status == 0 ; + ok 19, $@ eq "" ; + #print "[$@]\n" ; +} + +{ + # closing a database with an open transaction + my $lex = new LexFile $Dfile ; + my %hash ; + + ok 20, my $lexD = new LexDir($home); + ok 21, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + + ok 22, my $txn = $env->txn_begin() ; + ok 23, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + eval { $db->db_close() ; } ; + ok 24, $@ =~ /BerkeleyDB Aborting: attempted to close a database while a transaction was still open at/ ; + #print "[$@]\n" ; +} + +{ + # closing a cursor & a database + my $lex = new LexFile $Dfile ; + my %hash ; + my $status ; + ok 25, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE ; + ok 26, my $cursor = $db->db_cursor() ; + ok 27, $cursor->c_close() == 0 ; + eval { $status = $db->db_close() ; } ; + ok 28, $status == 0 ; + ok 29, $@ eq "" ; + #print "[$@]\n" ; +} + +{ + # closing a database with an open cursor + my $lex = new LexFile $Dfile ; + my %hash ; + ok 30, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE ; + ok 31, my $cursor = $db->db_cursor() ; + eval { $db->db_close() ; } ; + ok 32, $@ =~ /\QBerkeleyDB Aborting: attempted to close a database with 1 open cursor(s) at/; + #print "[$@]\n" ; +} + +{ + # closing a transaction & a cursor + my $lex = new LexFile $Dfile ; + my %hash ; + my $status ; + + ok 33, my $lexD = new LexDir($home); + ok 34, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 35, my $txn = $env->txn_begin() ; + ok 36, my $db = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + ok 37, my $cursor = $db->db_cursor() ; + eval { $status = $cursor->c_close() ; } ; + ok 38, $status == 0 ; + ok 39, ($status = $txn->txn_commit()) == 0 ; + ok 40, $@ eq "" ; + eval { $status = $db->db_close() ; } ; + ok 41, $status == 0 ; + ok 42, $@ eq "" ; + #print "[$@]\n" ; + eval { $status = $env->db_appexit() ; } ; + ok 43, $status == 0 ; + ok 44, $@ eq "" ; + #print "[$@]\n" ; +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/subdb.t b/storage/bdb/perl/BerkeleyDB/t/subdb.t new file mode 100644 index 00000000000..23016d6463f --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/subdb.t @@ -0,0 +1,243 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +BEGIN +{ + if ($BerkeleyDB::db_version < 3) { + print "1..0 # Skipping test, this needs Berkeley DB 3.x or better\n" ; + exit 0 ; + } +} + +print "1..43\n"; + +my $Dfile = "dbhash.tmp"; +my $Dfile2 = "dbhash2.tmp"; +my $Dfile3 = "dbhash3.tmp"; +unlink $Dfile; + +umask(0) ; + +# Berkeley DB 3.x specific functionality + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' BerkeleyDB::db_remove -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' BerkeleyDB::db_remove -Bad => 2, -Filename => "fred", -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) (Bad |Stupid ){2}/ ; + + eval ' BerkeleyDB::db_remove -Filename => "a", -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' BerkeleyDB::db_remove -Subname => "a"' ; + ok 4, $@ =~ /^Must specify a filename/ ; + + my $obj = bless [], "main" ; + eval ' BerkeleyDB::db_remove -Filename => "x", -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +{ + # subdatabases + + # opening a subdatabse in an exsiting database that doesn't have + # subdatabases at all should fail + + my $lex = new LexFile $Dfile ; + + ok 6, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a k/v pair + my %data = qw( + red sky + blue sea + black heart + yellow belley + green grass + ) ; + + ok 7, addData($db, %data) ; + + undef $db ; + + $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "fred" ; + ok 8, ! $db ; + + ok 9, -e $Dfile ; + ok 10, ! BerkeleyDB::db_remove(-Filename => $Dfile) ; +} + +{ + # subdatabases + + # opening a subdatabse in an exsiting database that does have + # subdatabases at all, but not this one + + my $lex = new LexFile $Dfile ; + + ok 11, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "fred" , + -Flags => DB_CREATE ; + + # Add a k/v pair + my %data = qw( + red sky + blue sea + black heart + yellow belley + green grass + ) ; + + ok 12, addData($db, %data) ; + + undef $db ; + + $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "joe" ; + + ok 13, !$db ; + +} + +{ + # subdatabases + + my $lex = new LexFile $Dfile ; + + ok 14, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "fred" , + -Flags => DB_CREATE ; + + # Add a k/v pair + my %data = qw( + red sky + blue sea + black heart + yellow belley + green grass + ) ; + + ok 15, addData($db, %data) ; + + undef $db ; + + ok 16, $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "fred" ; + + ok 17, my $cursor = $db->db_cursor() ; + my ($k, $v) = ("", "") ; + my $status ; + while (($status = $cursor->c_get($k, $v, DB_NEXT)) == 0) { + if ($data{$k} eq $v) { + delete $data{$k} ; + } + } + ok 18, $status == DB_NOTFOUND ; + ok 19, keys %data == 0 ; +} + +{ + # subdatabases + + # opening a database with multiple subdatabases - handle should be a list + # of the subdatabase names + + my $lex = new LexFile $Dfile ; + + ok 20, my $db1 = new BerkeleyDB::Hash -Filename => $Dfile, + -Subname => "fred" , + -Flags => DB_CREATE ; + + ok 21, my $db2 = new BerkeleyDB::Btree -Filename => $Dfile, + -Subname => "joe" , + -Flags => DB_CREATE ; + + # Add a k/v pair + my %data = qw( + red sky + blue sea + black heart + yellow belley + green grass + ) ; + + ok 22, addData($db1, %data) ; + ok 23, addData($db2, %data) ; + + undef $db1 ; + undef $db2 ; + + ok 24, my $db = new BerkeleyDB::Unknown -Filename => $Dfile , + -Flags => DB_RDONLY ; + + #my $type = $db->type() ; print "type $type\n" ; + ok 25, my $cursor = $db->db_cursor() ; + my ($k, $v) = ("", "") ; + my $status ; + my @dbnames = () ; + while (($status = $cursor->c_get($k, $v, DB_NEXT)) == 0) { + push @dbnames, $k ; + } + ok 26, $status == DB_NOTFOUND ; + ok 27, join(",", sort @dbnames) eq "fred,joe" ; + undef $db ; + + ok 28, BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "harry") != 0; + ok 29, BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "fred") == 0 ; + + # should only be one subdatabase + ok 30, $db = new BerkeleyDB::Unknown -Filename => $Dfile , + -Flags => DB_RDONLY ; + + ok 31, $cursor = $db->db_cursor() ; + @dbnames = () ; + while (($status = $cursor->c_get($k, $v, DB_NEXT)) == 0) { + push @dbnames, $k ; + } + ok 32, $status == DB_NOTFOUND ; + ok 33, join(",", sort @dbnames) eq "joe" ; + undef $db ; + + # can't delete an already deleted subdatabase + ok 34, BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "fred") != 0; + + ok 35, BerkeleyDB::db_remove(-Filename => $Dfile, -Subname => "joe") == 0 ; + + # should only be one subdatabase + ok 36, $db = new BerkeleyDB::Unknown -Filename => $Dfile , + -Flags => DB_RDONLY ; + + ok 37, $cursor = $db->db_cursor() ; + @dbnames = () ; + while (($status = $cursor->c_get($k, $v, DB_NEXT)) == 0) { + push @dbnames, $k ; + } + ok 38, $status == DB_NOTFOUND ; + ok 39, @dbnames == 0 ; + undef $db ; + undef $cursor ; + + ok 40, -e $Dfile ; + ok 41, BerkeleyDB::db_remove(-Filename => $Dfile) == 0 ; + ok 42, ! -e $Dfile ; + ok 43, BerkeleyDB::db_remove(-Filename => $Dfile) != 0 ; +} + +# db_remove with env diff --git a/storage/bdb/perl/BerkeleyDB/t/txn.t b/storage/bdb/perl/BerkeleyDB/t/txn.t new file mode 100644 index 00000000000..ba6b636cdc8 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/txn.t @@ -0,0 +1,320 @@ +#!./perl -w + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..58\n"; + +my $Dfile = "dbhash.tmp"; + +umask(0); + +{ + # error cases + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 1, my $lexD = new LexDir($home); + ok 2, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE| DB_INIT_MPOOL; + eval { $env->txn_begin() ; } ; + ok 3, $@ =~ /^BerkeleyDB Aborting: Transaction Manager not enabled at/ ; + + eval { my $txn_mgr = $env->TxnMgr() ; } ; + ok 4, $@ =~ /^BerkeleyDB Aborting: Transaction Manager not enabled at/ ; + undef $env ; + +} + +{ + # transaction - abort works + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 5, my $lexD = new LexDir($home); + ok 6, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 7, my $txn = $env->txn_begin() ; + ok 8, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + + ok 9, $txn->txn_commit() == 0 ; + ok 10, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 11, $ret == 0 ; + + # should be able to see all the records + + ok 12, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 13, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 14, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 15, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 16, $count == 0 ; + + my $stat = $env->txn_stat() ; + ok 17, $stat->{'st_naborts'} == 1 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie %hash ; +} + +{ + # transaction - abort works via txnmgr + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 18, my $lexD = new LexDir($home); + ok 19, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 20, my $txn_mgr = $env->TxnMgr() ; + ok 21, my $txn = $txn_mgr->txn_begin() ; + ok 22, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + ok 23, $txn->txn_commit() == 0 ; + ok 24, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 25, $ret == 0 ; + + # should be able to see all the records + + ok 26, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 27, $count == 3 ; + undef $cursor ; + + # now abort the transaction + ok 28, $txn->txn_abort() == 0 ; + + # there shouldn't be any records in the database + $count = 0 ; + # sequence forwards + ok 29, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 30, $count == 0 ; + + my $stat = $txn_mgr->txn_stat() ; + ok 31, $stat->{'st_naborts'} == 1 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $txn_mgr ; + undef $env ; + untie %hash ; +} + +{ + # transaction - commit works + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 32, my $lexD = new LexDir($home); + ok 33, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 34, my $txn = $env->txn_begin() ; + ok 35, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + + ok 36, $txn->txn_commit() == 0 ; + ok 37, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 38, $ret == 0 ; + + # should be able to see all the records + + ok 39, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 40, $count == 3 ; + undef $cursor ; + + # now commit the transaction + ok 41, $txn->txn_commit() == 0 ; + + $count = 0 ; + # sequence forwards + ok 42, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 43, $count == 3 ; + + my $stat = $env->txn_stat() ; + ok 44, $stat->{'st_naborts'} == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $env ; + untie %hash ; +} + +{ + # transaction - commit works via txnmgr + + my $lex = new LexFile $Dfile ; + my %hash ; + my $value ; + + my $home = "./fred" ; + ok 45, my $lexD = new LexDir($home); + ok 46, my $env = new BerkeleyDB::Env -Home => $home, + -Flags => DB_CREATE|DB_INIT_TXN| + DB_INIT_MPOOL|DB_INIT_LOCK ; + ok 47, my $txn_mgr = $env->TxnMgr() ; + ok 48, my $txn = $txn_mgr->txn_begin() ; + ok 49, my $db1 = tie %hash, 'BerkeleyDB::Hash', -Filename => $Dfile, + -Flags => DB_CREATE , + -Env => $env, + -Txn => $txn ; + + ok 50, $txn->txn_commit() == 0 ; + ok 51, $txn = $env->txn_begin() ; + $db1->Txn($txn); + + # create some data + my %data = ( + "red" => "boat", + "green" => "house", + "blue" => "sea", + ) ; + + my $ret = 0 ; + while (my ($k, $v) = each %data) { + $ret += $db1->db_put($k, $v) ; + } + ok 52, $ret == 0 ; + + # should be able to see all the records + + ok 53, my $cursor = $db1->db_cursor() ; + my ($k, $v) = ("", "") ; + my $count = 0 ; + # sequence forwards + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 54, $count == 3 ; + undef $cursor ; + + # now commit the transaction + ok 55, $txn->txn_commit() == 0 ; + + $count = 0 ; + # sequence forwards + ok 56, $cursor = $db1->db_cursor() ; + while ($cursor->c_get($k, $v, DB_NEXT) == 0) { + ++ $count ; + } + ok 57, $count == 3 ; + + my $stat = $txn_mgr->txn_stat() ; + ok 58, $stat->{'st_naborts'} == 0 ; + + undef $txn ; + undef $cursor ; + undef $db1 ; + undef $txn_mgr ; + undef $env ; + untie %hash ; +} + diff --git a/storage/bdb/perl/BerkeleyDB/t/unknown.t b/storage/bdb/perl/BerkeleyDB/t/unknown.t new file mode 100644 index 00000000000..f2630b585c0 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/unknown.t @@ -0,0 +1,176 @@ +#!./perl -w + +# ID: %I%, %G% + +use strict ; + +BEGIN { + unless(grep /blib/, @INC) { + chdir 't' if -d 't'; + @INC = '../lib' if -d '../lib'; + } +} + +use BerkeleyDB; +use t::util ; + +print "1..41\n"; + +my $Dfile = "dbhash.tmp"; +unlink $Dfile; + +umask(0) ; + + +# Check for invalid parameters +{ + # Check for invalid parameters + my $db ; + eval ' $db = new BerkeleyDB::Unknown -Stupid => 3 ; ' ; + ok 1, $@ =~ /unknown key value\(s\) Stupid/ ; + + eval ' $db = new BerkeleyDB::Unknown -Bad => 2, -Mode => 0345, -Stupid => 3; ' ; + ok 2, $@ =~ /unknown key value\(s\) (Bad |Stupid ){2}/ ; + + eval ' $db = new BerkeleyDB::Unknown -Env => 2 ' ; + ok 3, $@ =~ /^Env not of type BerkeleyDB::Env/ ; + + eval ' $db = new BerkeleyDB::Unknown -Txn => "fred" ' ; + ok 4, $@ =~ /^Txn not of type BerkeleyDB::Txn/ ; + + my $obj = bless [], "main" ; + eval ' $db = new BerkeleyDB::Unknown -Env => $obj ' ; + ok 5, $@ =~ /^Env not of type BerkeleyDB::Env/ ; +} + +# check the interface to a rubbish database +{ + # first an empty file + my $lex = new LexFile $Dfile ; + ok 6, writeFile($Dfile, "") ; + + ok 7, ! (new BerkeleyDB::Unknown -Filename => $Dfile); + + # now a non-database file + writeFile($Dfile, "\x2af6") ; + ok 8, ! (new BerkeleyDB::Unknown -Filename => $Dfile); +} + +# check the interface to a Hash database + +{ + my $lex = new LexFile $Dfile ; + + # create a hash database + ok 9, my $db = new BerkeleyDB::Hash -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a few k/v pairs + my $value ; + my $status ; + ok 10, $db->db_put("some key", "some value") == 0 ; + ok 11, $db->db_put("key", "value") == 0 ; + + # close the database + undef $db ; + + # now open it with Unknown + ok 12, $db = new BerkeleyDB::Unknown -Filename => $Dfile; + + ok 13, $db->type() == DB_HASH ; + ok 14, $db->db_get("some key", $value) == 0 ; + ok 15, $value eq "some value" ; + ok 16, $db->db_get("key", $value) == 0 ; + ok 17, $value eq "value" ; + + my @array ; + eval { $db->Tie(\@array)} ; + ok 18, $@ =~ /^Tie needs a reference to a hash/ ; + + my %hash ; + $db->Tie(\%hash) ; + ok 19, $hash{"some key"} eq "some value" ; + +} + +# check the interface to a Btree database + +{ + my $lex = new LexFile $Dfile ; + + # create a hash database + ok 20, my $db = new BerkeleyDB::Btree -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a few k/v pairs + my $value ; + my $status ; + ok 21, $db->db_put("some key", "some value") == 0 ; + ok 22, $db->db_put("key", "value") == 0 ; + + # close the database + undef $db ; + + # now open it with Unknown + # create a hash database + ok 23, $db = new BerkeleyDB::Unknown -Filename => $Dfile; + + ok 24, $db->type() == DB_BTREE ; + ok 25, $db->db_get("some key", $value) == 0 ; + ok 26, $value eq "some value" ; + ok 27, $db->db_get("key", $value) == 0 ; + ok 28, $value eq "value" ; + + + my @array ; + eval { $db->Tie(\@array)} ; + ok 29, $@ =~ /^Tie needs a reference to a hash/ ; + + my %hash ; + $db->Tie(\%hash) ; + ok 30, $hash{"some key"} eq "some value" ; + + +} + +# check the interface to a Recno database + +{ + my $lex = new LexFile $Dfile ; + + # create a recno database + ok 31, my $db = new BerkeleyDB::Recno -Filename => $Dfile, + -Flags => DB_CREATE ; + + # Add a few k/v pairs + my $value ; + my $status ; + ok 32, $db->db_put(0, "some value") == 0 ; + ok 33, $db->db_put(1, "value") == 0 ; + + # close the database + undef $db ; + + # now open it with Unknown + # create a hash database + ok 34, $db = new BerkeleyDB::Unknown -Filename => $Dfile; + + ok 35, $db->type() == DB_RECNO ; + ok 36, $db->db_get(0, $value) == 0 ; + ok 37, $value eq "some value" ; + ok 38, $db->db_get(1, $value) == 0 ; + ok 39, $value eq "value" ; + + + my %hash ; + eval { $db->Tie(\%hash)} ; + ok 40, $@ =~ /^Tie needs a reference to an array/ ; + + my @array ; + $db->Tie(\@array) ; + ok 41, $array[1] eq "value" ; + + +} + +# check i/f to text diff --git a/storage/bdb/perl/BerkeleyDB/t/util.pm b/storage/bdb/perl/BerkeleyDB/t/util.pm new file mode 100644 index 00000000000..1a1449751eb --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/t/util.pm @@ -0,0 +1,220 @@ +package util ; + +package main ; + +use strict ; +use BerkeleyDB ; +use File::Path qw(rmtree); +use vars qw(%DB_errors $FA) ; + +$| = 1; + +%DB_errors = ( + 'DB_INCOMPLETE' => "DB_INCOMPLETE: Sync was unable to complete", + 'DB_KEYEMPTY' => "DB_KEYEMPTY: Non-existent key/data pair", + 'DB_KEYEXIST' => "DB_KEYEXIST: Key/data pair already exists", + 'DB_LOCK_DEADLOCK' => "DB_LOCK_DEADLOCK: Locker killed to resolve a deadlock", + 'DB_LOCK_NOTGRANTED' => "DB_LOCK_NOTGRANTED: Lock not granted", + 'DB_NOTFOUND' => "DB_NOTFOUND: No matching key/data pair found", + 'DB_OLD_VERSION' => "DB_OLDVERSION: Database requires a version upgrade", + 'DB_RUNRECOVERY' => "DB_RUNRECOVERY: Fatal error, run database recovery", +) ; + +# full tied array support started in Perl 5.004_57 +# just double check. +$FA = 0 ; +{ + sub try::TIEARRAY { bless [], "try" } + sub try::FETCHSIZE { $FA = 1 } + my @a ; + tie @a, 'try' ; + my $a = @a ; +} + +{ + package LexFile ; + + use vars qw( $basename @files ) ; + $basename = "db0000" ; + + sub new + { + my $self = shift ; + #my @files = () ; + foreach (@_) + { + $_ = $basename ; + unlink $basename ; + push @files, $basename ; + ++ $basename ; + } + bless [ @files ], $self ; + } + + sub DESTROY + { + my $self = shift ; + #unlink @{ $self } ; + } + + END + { + foreach (@files) { unlink $_ } + } +} + + +{ + package LexDir ; + + use File::Path qw(rmtree); + + use vars qw( $basename %dirs ) ; + + sub new + { + my $self = shift ; + my $dir = shift ; + + rmtree $dir if -e $dir ; + + mkdir $dir, 0777 or return undef ; + + return bless [ $dir ], $self ; + } + + sub DESTROY + { + my $self = shift ; + my $dir = $self->[0]; + #rmtree $dir; + $dirs{$dir} ++ ; + } + + END + { + foreach (keys %dirs) { + rmtree $_ if -d $_ ; + } + } + +} + +{ + package Redirect ; + use Symbol ; + + sub new + { + my $class = shift ; + my $filename = shift ; + my $fh = gensym ; + open ($fh, ">$filename") || die "Cannot open $filename: $!" ; + my $real_stdout = select($fh) ; + return bless [$fh, $real_stdout ] ; + + } + sub DESTROY + { + my $self = shift ; + close $self->[0] ; + select($self->[1]) ; + } +} + +sub docat +{ + my $file = shift; + local $/ = undef; + open(CAT,$file) || die "Cannot open $file:$!"; + my $result = <CAT>; + close(CAT); + return $result; +} + +sub docat_del +{ + my $file = shift; + local $/ = undef; + open(CAT,$file) || die "Cannot open $file: $!"; + my $result = <CAT> || "" ; + close(CAT); + unlink $file ; + return $result; +} + +sub writeFile +{ + my $name = shift ; + open(FH, ">$name") or return 0 ; + print FH @_ ; + close FH ; + return 1 ; +} + +sub touch +{ + my $file = shift ; + open(CAT,">$file") || die "Cannot open $file:$!"; + close(CAT); +} + +sub joiner +{ + my $db = shift ; + my $sep = shift ; + my ($k, $v) = (0, "") ; + my @data = () ; + + my $cursor = $db->db_cursor() or return () ; + for ( my $status = $cursor->c_get($k, $v, DB_FIRST) ; + $status == 0 ; + $status = $cursor->c_get($k, $v, DB_NEXT)) { + push @data, $v ; + } + + (scalar(@data), join($sep, @data)) ; +} + +sub countRecords +{ + my $db = shift ; + my ($k, $v) = (0,0) ; + my ($count) = 0 ; + my ($cursor) = $db->db_cursor() ; + #for ($status = $cursor->c_get($k, $v, DB_FIRST) ; +# $status == 0 ; +# $status = $cursor->c_get($k, $v, DB_NEXT) ) + while ($cursor->c_get($k, $v, DB_NEXT) == 0) + { ++ $count } + + return $count ; +} + +sub addData +{ + my $db = shift ; + my @data = @_ ; + die "addData odd data\n" if @data % 2 != 0 ; + my ($k, $v) ; + my $ret = 0 ; + while (@data) { + $k = shift @data ; + $v = shift @data ; + $ret += $db->db_put($k, $v) ; + } + + return ($ret == 0) ; +} + +sub ok +{ + my $no = shift ; + my $result = shift ; + + print "not " unless $result ; + print "ok $no\n" ; +} + + +1; diff --git a/storage/bdb/perl/BerkeleyDB/typemap b/storage/bdb/perl/BerkeleyDB/typemap new file mode 100644 index 00000000000..81ead2c36d9 --- /dev/null +++ b/storage/bdb/perl/BerkeleyDB/typemap @@ -0,0 +1,275 @@ +# typemap for Perl 5 interface to Berkeley DB version 2 & 3 +# +# SCCS: %I%, %G% +# +# written by Paul Marquess <Paul.Marquess@btinternet.com> +# +#################################### DB SECTION +# +# + +void * T_PV +u_int T_U_INT +u_int32_t T_U_INT +const char * T_PV_NULL +PV_or_NULL T_PV_NULL +IO_or_NULL T_IO_NULL + +AV * T_AV + +BerkeleyDB T_PTROBJ +BerkeleyDB::Common T_PTROBJ_AV +BerkeleyDB::Hash T_PTROBJ_AV +BerkeleyDB::Btree T_PTROBJ_AV +BerkeleyDB::Recno T_PTROBJ_AV +BerkeleyDB::Queue T_PTROBJ_AV +BerkeleyDB::Cursor T_PTROBJ_AV +BerkeleyDB::TxnMgr T_PTROBJ_AV +BerkeleyDB::Txn T_PTROBJ_AV +BerkeleyDB::Log T_PTROBJ_AV +BerkeleyDB::Lock T_PTROBJ_AV +BerkeleyDB::Env T_PTROBJ_AV + +BerkeleyDB::Raw T_RAW +BerkeleyDB::Common::Raw T_RAW +BerkeleyDB::Hash::Raw T_RAW +BerkeleyDB::Btree::Raw T_RAW +BerkeleyDB::Recno::Raw T_RAW +BerkeleyDB::Queue::Raw T_RAW +BerkeleyDB::Cursor::Raw T_RAW +BerkeleyDB::TxnMgr::Raw T_RAW +BerkeleyDB::Txn::Raw T_RAW +BerkeleyDB::Log::Raw T_RAW +BerkeleyDB::Lock::Raw T_RAW +BerkeleyDB::Env::Raw T_RAW + +BerkeleyDB::Env::Inner T_INNER +BerkeleyDB::Common::Inner T_INNER +BerkeleyDB::Txn::Inner T_INNER +BerkeleyDB::TxnMgr::Inner T_INNER +# BerkeleyDB__Env T_PTR +DBT T_dbtdatum +DBT_OPT T_dbtdatum_opt +DBT_B T_dbtdatum_btree +DBTKEY T_dbtkeydatum +DBTKEY_B T_dbtkeydatum_btree +DBTYPE T_U_INT +DualType T_DUAL +BerkeleyDB_type * T_IV +BerkeleyDB_ENV_type * T_IV +BerkeleyDB_TxnMgr_type * T_IV +BerkeleyDB_Txn_type * T_IV +BerkeleyDB__Cursor_type * T_IV +DB * T_IV + +INPUT + +T_AV + if (SvROK($arg) && SvTYPE(SvRV($arg)) == SVt_PVAV) + /* if (sv_isa($arg, \"${ntype}\")) */ + $var = (AV*)SvRV($arg); + else + croak(\"$var is not an array reference\") + +T_RAW + $var = INT2PTR($type,SvIV($arg) + +T_U_INT + $var = SvUV($arg) + +T_SV_REF_NULL + if ($arg == &PL_sv_undef) + $var = NULL ; + else if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV *)GetInternalObject($arg)); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + +T_HV_REF_NULL + if ($arg == &PL_sv_undef) + $var = NULL ; + else if (sv_derived_from($arg, \"${ntype}\")) { + HV * hv = (HV *)GetInternalObject($arg); + SV ** svp = hv_fetch(hv, \"db\", 2, FALSE); + IV tmp = SvIV(*svp); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + +T_HV_REF + if (sv_derived_from($arg, \"${ntype}\")) { + HV * hv = (HV *)GetInternalObject($arg); + SV ** svp = hv_fetch(hv, \"db\", 2, FALSE); + IV tmp = SvIV(*svp); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + + +T_P_REF + if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + + +T_INNER + { + HV * hv = (HV *)SvRV($arg); + SV ** svp = hv_fetch(hv, \"db\", 2, FALSE); + IV tmp = SvIV(*svp); + $var = INT2PTR($type, tmp); + } + +T_PV_NULL + if ($arg == &PL_sv_undef) + $var = NULL ; + else { + $var = ($type)SvPV($arg,PL_na) ; + if (PL_na == 0) + $var = NULL ; + } + +T_IO_NULL + if ($arg == &PL_sv_undef) + $var = NULL ; + else + $var = IoOFP(sv_2io($arg)) + +T_PTROBJ_NULL + if ($arg == &PL_sv_undef) + $var = NULL ; + else if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + +T_PTROBJ_SELF + if ($arg == &PL_sv_undef) + $var = NULL ; + else if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + +T_PTROBJ_AV + if ($arg == &PL_sv_undef || $arg == NULL) + $var = NULL ; + else if (sv_derived_from($arg, \"${ntype}\")) { + IV tmp = SvIV(getInnerObject($arg)) ; + $var = INT2PTR($type, tmp); + } + else + croak(\"$var is not of type ${ntype}\") + +T_dbtkeydatum + DBM_ckFilter($arg, filter_store_key, \"filter_store_key\"); + DBT_clear($var) ; + if (db->recno_or_queue) { + Value = GetRecnoKey(db, SvIV($arg)) ; + $var.data = & Value; + $var.size = (int)sizeof(db_recno_t); + } + else { + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + } + +T_dbtkeydatum_btree + DBM_ckFilter($arg, filter_store_key, \"filter_store_key\"); + DBT_clear($var) ; + if (db->recno_or_queue || + (db->type == DB_BTREE && flagSet(DB_SET_RECNO))) { + Value = GetRecnoKey(db, SvIV($arg)) ; + $var.data = & Value; + $var.size = (int)sizeof(db_recno_t); + } + else { + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + } + +T_dbtdatum + DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); + DBT_clear($var) ; + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + $var.flags = db->partial ; + $var.dlen = db->dlen ; + $var.doff = db->doff ; + +T_dbtdatum_opt + DBT_clear($var) ; + if (flagSet(DB_GET_BOTH)) { + DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + $var.flags = db->partial ; + $var.dlen = db->dlen ; + $var.doff = db->doff ; + } + +T_dbtdatum_btree + DBT_clear($var) ; + if (flagSet(DB_GET_BOTH)) { + DBM_ckFilter($arg, filter_store_value, \"filter_store_value\"); + $var.data = SvPV($arg, PL_na); + $var.size = (int)PL_na; + $var.flags = db->partial ; + $var.dlen = db->dlen ; + $var.doff = db->doff ; + } + + +OUTPUT + +T_RAW + sv_setiv($arg, PTR2IV($var)); + +T_SV_REF_NULL + sv_setiv($arg, PTR2IV($var)); + +T_HV_REF_NULL + sv_setiv($arg, PTR2IV($var)); + +T_HV_REF + sv_setiv($arg, PTR2IV($var)); + +T_P_REF + sv_setiv($arg, PTR2IV($var)); + +T_DUAL + setDUALerrno($arg, $var) ; + +T_U_INT + sv_setuv($arg, (UV)$var); + +T_PV_NULL + sv_setpv((SV*)$arg, $var); + +T_dbtkeydatum_btree + OutputKey_B($arg, $var) +T_dbtkeydatum + OutputKey($arg, $var) +T_dbtdatum + OutputValue($arg, $var) +T_dbtdatum_opt + OutputValue($arg, $var) +T_dbtdatum_btree + OutputValue_B($arg, $var) + +T_PTROBJ_NULL + sv_setref_pv($arg, \"${ntype}\", (void*)$var); + +T_PTROBJ_SELF + sv_setref_pv($arg, self, (void*)$var); |