diff options
Diffstat (limited to 'bdb/perl/BerkeleyDB')
52 files changed, 0 insertions, 24265 deletions
diff --git a/bdb/perl/BerkeleyDB/BerkeleyDB.pm b/bdb/perl/BerkeleyDB/BerkeleyDB.pm deleted file mode 100644 index c56390ba71f..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB.pm +++ /dev/null @@ -1,1506 +0,0 @@ - -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/bdb/perl/BerkeleyDB/BerkeleyDB.pod b/bdb/perl/BerkeleyDB/BerkeleyDB.pod deleted file mode 100644 index 60f30e2abfb..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB.pod +++ /dev/null @@ -1,1792 +0,0 @@ -=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/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P b/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P deleted file mode 100644 index 4a848f5388d..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB.pod.P +++ /dev/null @@ -1,1559 +0,0 @@ -=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/bdb/perl/BerkeleyDB/BerkeleyDB.xs b/bdb/perl/BerkeleyDB/BerkeleyDB.xs deleted file mode 100644 index 531b38a655f..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB.xs +++ /dev/null @@ -1,3643 +0,0 @@ -/* - - 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/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm b/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm deleted file mode 100644 index ba9a9c0085d..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB/Btree.pm +++ /dev/null @@ -1,8 +0,0 @@ - -package BerkeleyDB::Btree ; - -# This file is only used for MLDBM - -use BerkeleyDB ; - -1 ; diff --git a/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm b/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm deleted file mode 100644 index 8e7bc7e78c7..00000000000 --- a/bdb/perl/BerkeleyDB/BerkeleyDB/Hash.pm +++ /dev/null @@ -1,8 +0,0 @@ - -package BerkeleyDB::Hash ; - -# This file is only used for MLDBM - -use BerkeleyDB ; - -1 ; diff --git a/bdb/perl/BerkeleyDB/Changes b/bdb/perl/BerkeleyDB/Changes deleted file mode 100644 index cbeb1a34d73..00000000000 --- a/bdb/perl/BerkeleyDB/Changes +++ /dev/null @@ -1,167 +0,0 @@ -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/bdb/perl/BerkeleyDB/MANIFEST b/bdb/perl/BerkeleyDB/MANIFEST deleted file mode 100644 index 7da51ef7d7c..00000000000 --- a/bdb/perl/BerkeleyDB/MANIFEST +++ /dev/null @@ -1,56 +0,0 @@ -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/bdb/perl/BerkeleyDB/Makefile.PL b/bdb/perl/BerkeleyDB/Makefile.PL deleted file mode 100644 index 86da9a845af..00000000000 --- a/bdb/perl/BerkeleyDB/Makefile.PL +++ /dev/null @@ -1,123 +0,0 @@ -#! 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/bdb/perl/BerkeleyDB/README b/bdb/perl/BerkeleyDB/README deleted file mode 100644 index a600e313193..00000000000 --- a/bdb/perl/BerkeleyDB/README +++ /dev/null @@ -1,484 +0,0 @@ - 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/bdb/perl/BerkeleyDB/Todo b/bdb/perl/BerkeleyDB/Todo deleted file mode 100644 index 12d53bcf91c..00000000000 --- a/bdb/perl/BerkeleyDB/Todo +++ /dev/null @@ -1,57 +0,0 @@ - - * 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/bdb/perl/BerkeleyDB/config.in b/bdb/perl/BerkeleyDB/config.in deleted file mode 100644 index fd1bb1caede..00000000000 --- a/bdb/perl/BerkeleyDB/config.in +++ /dev/null @@ -1,43 +0,0 @@ -# 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/bdb/perl/BerkeleyDB/constants.h b/bdb/perl/BerkeleyDB/constants.h deleted file mode 100644 index d86cef15513..00000000000 --- a/bdb/perl/BerkeleyDB/constants.h +++ /dev/null @@ -1,4046 +0,0 @@ -#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/bdb/perl/BerkeleyDB/constants.xs b/bdb/perl/BerkeleyDB/constants.xs deleted file mode 100644 index 1b2c8b2c3c8..00000000000 --- a/bdb/perl/BerkeleyDB/constants.xs +++ /dev/null @@ -1,87 +0,0 @@ -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/bdb/perl/BerkeleyDB/dbinfo b/bdb/perl/BerkeleyDB/dbinfo deleted file mode 100755 index af2c45facf5..00000000000 --- a/bdb/perl/BerkeleyDB/dbinfo +++ /dev/null @@ -1,112 +0,0 @@ -#!/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/bdb/perl/BerkeleyDB/hints/dec_osf.pl b/bdb/perl/BerkeleyDB/hints/dec_osf.pl deleted file mode 100644 index 6d7faeed2e2..00000000000 --- a/bdb/perl/BerkeleyDB/hints/dec_osf.pl +++ /dev/null @@ -1 +0,0 @@ -$self->{LIBS} = [ "@{$self->{LIBS}} -lpthreads" ]; diff --git a/bdb/perl/BerkeleyDB/hints/irix_6_5.pl b/bdb/perl/BerkeleyDB/hints/irix_6_5.pl deleted file mode 100644 index b531673e6e0..00000000000 --- a/bdb/perl/BerkeleyDB/hints/irix_6_5.pl +++ /dev/null @@ -1 +0,0 @@ -$self->{LIBS} = [ "@{$self->{LIBS}} -lthread" ]; diff --git a/bdb/perl/BerkeleyDB/hints/solaris.pl b/bdb/perl/BerkeleyDB/hints/solaris.pl deleted file mode 100644 index ddd941d634a..00000000000 --- a/bdb/perl/BerkeleyDB/hints/solaris.pl +++ /dev/null @@ -1 +0,0 @@ -$self->{LIBS} = [ "@{$self->{LIBS}} -lmt" ]; diff --git a/bdb/perl/BerkeleyDB/mkconsts b/bdb/perl/BerkeleyDB/mkconsts deleted file mode 100644 index 7e0964333cc..00000000000 --- a/bdb/perl/BerkeleyDB/mkconsts +++ /dev/null @@ -1,770 +0,0 @@ -#!/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/bdb/perl/BerkeleyDB/mkpod b/bdb/perl/BerkeleyDB/mkpod deleted file mode 100755 index 44bbf3fbf4f..00000000000 --- a/bdb/perl/BerkeleyDB/mkpod +++ /dev/null @@ -1,146 +0,0 @@ -#!/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/bdb/perl/BerkeleyDB/patches/5.004 b/bdb/perl/BerkeleyDB/patches/5.004 deleted file mode 100644 index 143ec95afbc..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004 +++ /dev/null @@ -1,44 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.004_01 b/bdb/perl/BerkeleyDB/patches/5.004_01 deleted file mode 100644 index 1b05eb4e02b..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004_01 +++ /dev/null @@ -1,217 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.004_02 b/bdb/perl/BerkeleyDB/patches/5.004_02 deleted file mode 100644 index 238f8737941..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004_02 +++ /dev/null @@ -1,217 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.004_03 b/bdb/perl/BerkeleyDB/patches/5.004_03 deleted file mode 100644 index 06331eac922..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004_03 +++ /dev/null @@ -1,223 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.004_04 b/bdb/perl/BerkeleyDB/patches/5.004_04 deleted file mode 100644 index a227dc700d9..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004_04 +++ /dev/null @@ -1,209 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.004_05 b/bdb/perl/BerkeleyDB/patches/5.004_05 deleted file mode 100644 index 51c8bf35009..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.004_05 +++ /dev/null @@ -1,209 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.005 b/bdb/perl/BerkeleyDB/patches/5.005 deleted file mode 100644 index effee3e8275..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.005 +++ /dev/null @@ -1,209 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.005_01 b/bdb/perl/BerkeleyDB/patches/5.005_01 deleted file mode 100644 index 2a05dd545f6..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.005_01 +++ /dev/null @@ -1,209 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.005_02 b/bdb/perl/BerkeleyDB/patches/5.005_02 deleted file mode 100644 index 5dd57ddc03f..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.005_02 +++ /dev/null @@ -1,264 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.005_03 b/bdb/perl/BerkeleyDB/patches/5.005_03 deleted file mode 100644 index 115f9f5b909..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.005_03 +++ /dev/null @@ -1,250 +0,0 @@ -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/bdb/perl/BerkeleyDB/patches/5.6.0 b/bdb/perl/BerkeleyDB/patches/5.6.0 deleted file mode 100644 index 1f9b3b620de..00000000000 --- a/bdb/perl/BerkeleyDB/patches/5.6.0 +++ /dev/null @@ -1,294 +0,0 @@ -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/bdb/perl/BerkeleyDB/ppport.h b/bdb/perl/BerkeleyDB/ppport.h deleted file mode 100644 index 0887c2159a9..00000000000 --- a/bdb/perl/BerkeleyDB/ppport.h +++ /dev/null @@ -1,329 +0,0 @@ -/* 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/bdb/perl/BerkeleyDB/scan b/bdb/perl/BerkeleyDB/scan deleted file mode 100644 index eb064950b2e..00000000000 --- a/bdb/perl/BerkeleyDB/scan +++ /dev/null @@ -1,229 +0,0 @@ -#!/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/bdb/perl/BerkeleyDB/t/btree.t b/bdb/perl/BerkeleyDB/t/btree.t deleted file mode 100644 index fd6ed8f1268..00000000000 --- a/bdb/perl/BerkeleyDB/t/btree.t +++ /dev/null @@ -1,931 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/destroy.t b/bdb/perl/BerkeleyDB/t/destroy.t deleted file mode 100644 index 7457d36c583..00000000000 --- a/bdb/perl/BerkeleyDB/t/destroy.t +++ /dev/null @@ -1,105 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/env.t b/bdb/perl/BerkeleyDB/t/env.t deleted file mode 100644 index 3905abfae43..00000000000 --- a/bdb/perl/BerkeleyDB/t/env.t +++ /dev/null @@ -1,217 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/examples.t b/bdb/perl/BerkeleyDB/t/examples.t deleted file mode 100644 index 69b7f8ff8c5..00000000000 --- a/bdb/perl/BerkeleyDB/t/examples.t +++ /dev/null @@ -1,401 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/examples.t.T b/bdb/perl/BerkeleyDB/t/examples.t.T deleted file mode 100644 index fe9bdf76b06..00000000000 --- a/bdb/perl/BerkeleyDB/t/examples.t.T +++ /dev/null @@ -1,415 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/examples3.t b/bdb/perl/BerkeleyDB/t/examples3.t deleted file mode 100644 index 22e94b770e1..00000000000 --- a/bdb/perl/BerkeleyDB/t/examples3.t +++ /dev/null @@ -1,132 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/examples3.t.T b/bdb/perl/BerkeleyDB/t/examples3.t.T deleted file mode 100644 index 5eeaa14d00c..00000000000 --- a/bdb/perl/BerkeleyDB/t/examples3.t.T +++ /dev/null @@ -1,136 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/filter.t b/bdb/perl/BerkeleyDB/t/filter.t deleted file mode 100644 index 47a7c107acf..00000000000 --- a/bdb/perl/BerkeleyDB/t/filter.t +++ /dev/null @@ -1,217 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/hash.t b/bdb/perl/BerkeleyDB/t/hash.t deleted file mode 100644 index 0e683851c3d..00000000000 --- a/bdb/perl/BerkeleyDB/t/hash.t +++ /dev/null @@ -1,728 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/join.t b/bdb/perl/BerkeleyDB/t/join.t deleted file mode 100644 index ed9b6a269cb..00000000000 --- a/bdb/perl/BerkeleyDB/t/join.t +++ /dev/null @@ -1,225 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/mldbm.t b/bdb/perl/BerkeleyDB/t/mldbm.t deleted file mode 100644 index d35f7e15895..00000000000 --- a/bdb/perl/BerkeleyDB/t/mldbm.t +++ /dev/null @@ -1,161 +0,0 @@ -#!/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/bdb/perl/BerkeleyDB/t/queue.t b/bdb/perl/BerkeleyDB/t/queue.t deleted file mode 100644 index 86add129ca4..00000000000 --- a/bdb/perl/BerkeleyDB/t/queue.t +++ /dev/null @@ -1,763 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/recno.t b/bdb/perl/BerkeleyDB/t/recno.t deleted file mode 100644 index 64b1803f736..00000000000 --- a/bdb/perl/BerkeleyDB/t/recno.t +++ /dev/null @@ -1,913 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/strict.t b/bdb/perl/BerkeleyDB/t/strict.t deleted file mode 100644 index ab41d44cb41..00000000000 --- a/bdb/perl/BerkeleyDB/t/strict.t +++ /dev/null @@ -1,174 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/subdb.t b/bdb/perl/BerkeleyDB/t/subdb.t deleted file mode 100644 index 23016d6463f..00000000000 --- a/bdb/perl/BerkeleyDB/t/subdb.t +++ /dev/null @@ -1,243 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/txn.t b/bdb/perl/BerkeleyDB/t/txn.t deleted file mode 100644 index ba6b636cdc8..00000000000 --- a/bdb/perl/BerkeleyDB/t/txn.t +++ /dev/null @@ -1,320 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/unknown.t b/bdb/perl/BerkeleyDB/t/unknown.t deleted file mode 100644 index f2630b585c0..00000000000 --- a/bdb/perl/BerkeleyDB/t/unknown.t +++ /dev/null @@ -1,176 +0,0 @@ -#!./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/bdb/perl/BerkeleyDB/t/util.pm b/bdb/perl/BerkeleyDB/t/util.pm deleted file mode 100644 index 1a1449751eb..00000000000 --- a/bdb/perl/BerkeleyDB/t/util.pm +++ /dev/null @@ -1,220 +0,0 @@ -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/bdb/perl/BerkeleyDB/typemap b/bdb/perl/BerkeleyDB/typemap deleted file mode 100644 index 81ead2c36d9..00000000000 --- a/bdb/perl/BerkeleyDB/typemap +++ /dev/null @@ -1,275 +0,0 @@ -# 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); |