Move DB_File from ext/ to cpan/

(Also XS, skipped on Win32 and VMS)

15 files changed, 0 insertions, 10063 deletions

diff --git a/ext/DB_File/.gitignore b/ext/DB_File/.gitignore
deleted file mode 100644
index f1c4edfa6e..0000000000
--- a/ext/DB_File/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-!/version.c
-/constants.*
-*.bak
diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
deleted file mode 100644
index 781a8b728f..0000000000
--- a/ext/DB_File/Changes
+++ /dev/null
@@ -1,549 +0,0 @@
-
-
-1.820 28 March 2009
-
-   * remove MAN3PODS from Makefile.PL to match core.
-
-1.819 18 February 2009
-
-   * t/db-recno.t fails if run in a path that contains spaces
-     [rt.cpan.org #43288]
-
-1.818 21 January 2009
-
-   * Updated Makefile.PL for Strawberry Perl. 
-     Patch suggested by David Golden.
-
-   * Remove IRIX notes from README. The page referenced doesn't exist
-     anymore.
-
-1.817 27 March 2008
-
-   * Updated dbinfo
-
-   * Applied core patch 32299 - Re-apply change #30562
-
-   * Applied core patch 32208
-
-   * Applied core patch 32884 - use MM->parse_version() in Makefile.PL
-
-   * Applied core patch 32883 -  Silence new warning grep in void context warning
-
-   * Applied core patch 32704 to remove use of PL_na in typemap
-
-   * Applied core patch 30562 to fix a build issue on OSF
-
-1.816 28 October 2007
-
-   * Clarified the warning about building with a different version of
-     Berkeley DB that is used at runtime.
-
-   * Also made the boot version check less strict.
-     [rt.cpan.org #30013]
-
-1.815 4 February 2007
-
-   * A few casting cleanups for building with C++ from Steve Peters.
-
-   * Fixed problem with recno which happened if you changed directory after
-     opening the database. Problem reported by Andrew Pam.
-
-
-1.814 11 November 2005
-
-   * Fix from Dominic Dunlop to tidy up an OS-X specific warning in
-     db-btree.t.
-
-   * Silenced a warning about $DB_File::Error only being used once.
-     Issue spotted by Dominic Dunlop.
-
-1.813 31st October 2005
-
-   * Updates for Berkeley DB 4.4
-
-1.812 9th October 2005
-
-   * Added libscan to Makefile.PL
-
-   * Fixed test failing under windows
-
-1.811 12th March 2005
-
-   * Fixed DBM filter bug in seq
-
-1.810 7th August 2004
-
-   * Fixed db-hash.t for Cygwin
-
-   * Added substr tests to db-hast.t
-
-   * Documented AIX build problem in README.
-
-1.809 20th June 2004
-
-   * Merged core patch 22258
-
-   * Merged core patch 22741
-
-   * Fixed core bug 30237. 
-     Using substr to pass parameters to the low-level Berkeley DB interface
-     causes problems with Perl 5.8.1 or better.
-     typemap fix supplied by Marcus Holland-Moritz.
-
-1.808 22nd December 2003
-
-   * Added extra DBM Filter tests.
-
-   * Fixed a memory leak in ParseOpenInfo, which whould occur if the
-     opening of the database failed. Leak spotted by Adrian Enache.
-
-1.807 1st November 2003
-
-   * Fixed minor typos on pod documetation - reported by Jeremy Mates &
-     Mark Jason Dominus.
-
-   * dbinfo updated to report when a database is encrypted.
-
-1.806 22nd October 2002
-
-   * Fixed problem when trying to build with a multi-threaded perl.
-
-   * Tidied up the recursion detetion code.
-
-   * merged core patch 17844 - missing dTHX declarations.
-
-   * merged core patch 17838 
-
-1.805 1st September 2002
-
-   * Added support to allow DB_File to build with Berkeley DB 4.1.X
-
-   * Tightened up the test harness to test that calls to untie don't generate
-     the "untie attempted while %d inner references still exist" warning.
-
-   * added code to guard against calling the callbacks (compare,hash & prefix) 
-     recursively.
-
-   * pasing undef for the flags and/or mode when opening a database could cause
-     a "Use of uninitialized value in subroutine entry" warning. Now silenced.
-
-   * DBM filter code beefed up to cope with read-only $_.
-
-1.804 2nd June 2002
-
-   * Perl core patch 14939 added a new warning to "splice". This broke the
-     db-recno test harness. Fixed.
-
-   * merged core patches 16502 & 16540.
-
-1.803 1st March 2002
-
-   * Fixed a problem with db-btree.t where it complained about an "our"
-     variable redeclaation.
-
-   * FETCH, STORE & DELETE don't map the flags parameter into the
-     equivalent Berkeley DB function anymore.
-
-1.802 6th January 2002
-
-   * The message about some test failing in db-recno.t had the wrong test
-     numbers. Fixed.
-
-   * merged core patch 13942.
-
-1.801 26th November 2001
-
-   * Fixed typo in Makefile.PL
-
-   * Added "clean" attribute to Makefile.PL
- 
-1.800 23rd November 2001
-
-   * use pport.h for perl backward compatability code.
-
-   * use new  ExtUtils::Constant module to generate XS constants.
-
-   * upgrade Makefile.PL upgrade/downgrade code to toggle "our" with
-     "use vars"
-
-1.79 22nd October 2001
-
-   * Added a "local $SIG{__DIE__}" inside the eval that checks for
-     the presence of XSLoader s suggested by Andrew Hryckowin.
-
-   * merged core patch 12277.
-
-   * Changed NEXTKEY to not initialise the input key. It isn't used anyway.
-
-1.79 22nd October 2001
-
-   * Fixed test harness for cygwin
-
-1.78 30th July 2001
-
-   * the test in Makefile.PL for AIX used -plthreads. Should have been
-     -lpthreads
-
-   * merged Core patches 
-        10372, 10335, 10372, 10534, 10549, 10643, 11051, 11194, 11432
-
-   * added documentation patch regarding duplicate keys from Andrew Johnson
-
-
-1.77 26th April 2001
-
-   * AIX is reported to need -lpthreads, so Makefile.PL now checks for
-     AIX and adds it to the link options.
-
-   * Minor documentation updates.
-
-   * Merged Core patch 9176
-
-   * Added a patch from Edward Avis that adds support for splice with
-     recno databases.
-
-   * Modified Makefile.PL to only enable the warnings pragma if using perl
-     5.6.1 or better.    
-
-1.76 15th January 2001
-
-   * Added instructions for using LD_PRELOAD to get Berkeley DB 2.x to work
-     with DB_File on Linux. Thanks to Norbert Bollow for sending details of
-     this approach.
-
-
-1.75 17th December 2000
-
-   * Fixed perl core patch 7703
-
-   * Added suppport to allow DB_File to be built with Berkeley DB 3.2 --
-     btree_compare, btree_prefix and hash_cb needed to be changed.
-
-   * Updated dbinfo to support Berkeley DB 3.2 file format changes.
-
-
-1.74 10th December 2000
-
-   * A "close" call in DB_File.xs needed parenthesised to stop win32 from
-     thinking it was one of its macros.
-
-   * Updated dbinfo to support Berkeley DB 3.1 file format changes.
-
-   * DB_File.pm & the test hasness now use the warnings pragma (when
-     available).
-
-   * Included Perl core patch 7703 -- size argument for hash_cb is different
-     for Berkeley DB 3.x
-
-   * Included Perl core patch 7801 -- Give __getBerkeleyDBInfo the ANSI C
-     treatment.
-
-   * @a = () produced the warning 'Argument "" isn't numeric in entersub'
-     This has been fixed. Thanks to Edward Avis for spotting this bug.
-
-   * Added note about building under Linux. Included patches.
-
-   * Included Perl core patch 8068 -- fix for bug 20001013.009 
-     When run with warnings enabled "$hash{XX} = undef " produced an
-     "Uninitialized value" warning. This has been fixed.
-
-1.73 31st May 2000
-
-   * Added support in version.c for building with threaded Perl.
-
-   * Berkeley DB 3.1 has reenabled support for null keys. The test
-     harness has been updated to reflect this.
-
-1.72 16th January 2000
-
-   * Added hints/sco.pl
-
-   * The module will now use XSLoader when it is available. When it
-     isn't it will use DynaLoader.
-
-   * The locking section in DB_File.pm has been discredited. Many thanks
-     to David Harris for spotting the underlying problem, contributing
-     the updates to the documentation and writing DB_File::Lock (available
-     on CPAN).
-
-1.71 7th September 1999
-
-   * Fixed a bug that prevented 1.70 from compiling under win32
-
-   * Updated to support Berkeley DB 3.x
-
-   * Updated dbinfo for Berkeley DB 3.x file formats.
-
-1.70 4th August 1999
-
-   * Initialise $DB_File::db_ver and $DB_File::db_version with
-     GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
-
-   * Added a BOOT check to test for equivalent versions of db.h &
-     libdb.a/so.
-
-1.69 3rd August 1999
-
-   * fixed a bug in push -- DB_APPEND wasn't working properly.
-
-   * Fixed the R_SETCURSOR bug introduced in 1.68
-
-   * Added a new Perl variable $DB_File::db_ver
-   
-1.68 22nd July 1999
-
-   * Merged changes from 5.005_58 
-
-   * Fixed a bug in R_IBEFORE & R_IAFTER procesing in Berkeley DB
-     2 databases.
-
-   * Added some of the examples in the POD into the test harness.
-
-1.67 6th June 1999
-
-   * Added DBM Filter documentation to DB_File.pm
-
-   * Fixed DBM Filter code to work with 5.004
-
-   * A few instances of newSVpvn were used in 1.66. This isn't available in
-     Perl 5.004_04 or earlier. Replaced with newSVpv.
-
-1.66 15th March 1999
-
-   * Added DBM Filter code
-
-1.65 6th March 1999
-
-   * Fixed a bug in the recno PUSH logic.
-   * The BOOT version check now needs 2.3.4 when using Berkeley DB version 2
-
-1.64 21st February 1999
-
-   * Tidied the 1.x to 2.x flag mapping code.
-   * Added a patch from Mark Kettenis <kettenis@wins.uva.nl> to fix a flag
-     mapping problem with O_RDONLY on the Hurd
-   * Updated the message that db-recno.t prints when tests 51, 53 or 55 fail.
-
-1.63 19th December 1998
-
-   * Fix to allow DB 2.6.x to build with DB_File
-   * Documentation updated to use push,pop etc in the RECNO example &
-     to include the find_dup & del_dup methods.
-
-1.62 30th November 1998
-
-   Added hints/dynixptx.pl.
-   Fixed typemap -- 1.61 used PL_na instead of na
-
-1.61 19th 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
-   Fixed a typo in the definition of O_RDONLY, courtesy of Mark Kettenis.
-
-1.60
-   Changed the test to check for full tied array support
-
-1.59
-   Updated the license section.
-
-   Berkeley DB 2.4.10 disallows zero length keys. Tests 32 & 42 in
-   db-btree.t and test 27 in db-hash.t failed because of this change.
-   Those tests have been zapped.
-
-   Added dbinfo to the distribution.
-
-1.58
-   Tied Array support was enhanced in Perl 5.004_57. DB_File now
-   supports PUSH,POP,SHIFT,UNSHIFT & STORESIZE.
-
-   Fixed a problem with the use of sv_setpvn. When the size is
-   specified as 0, it does a strlen on the data.  This was ok for DB
-   1.x, but isn't for DB 2.x.
-
-1.57
-   If Perl has been compiled with Threads support,the symbol op will be
-   defined. This clashes with a field name in db.h, so it needs to be
-   #undef'ed before db.h is included.
-
-1.56
-   Documented the Solaris 2.5 mutex bug
-
-1.55
-   Merged 1.16 changes.
-
-1.54
-
-   Fixed a small bug in the test harness when run under win32
-   The emulation of fd when useing DB 2.x was busted.
-
-1.53
-
-   Added DB_RENUMBER to flags for recno.
-
-1.52
-
-   Patch from Nick Ing-Simmons now allows DB_File to build on NT.
-   Merged 1.15 patch.
-
-1.51
-
-    Fixed the test harness so that it doesn't expect DB_File to have
-    been installed by the main Perl build.
-
-
-    Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
-
-1.50
-
-    DB_File can now build with either DB 1.x or 2.x, but not both at
-    the same time.
-
-1.16
-
-   A harmless looking tab was causing Makefile.PL to fail on AIX 3.2.5
-
-    Small fix for the AIX strict C compiler XLC which doesn't like
-    __attribute__ being defined via proto.h and redefined via db.h. Fix
-    courtesy of Jarkko Hietaniemi.
-
-1.15
-
-    Patch from Gisle Aas <gisle@aas.no> to suppress "use of undefined
-    value" warning with db_get and db_seq.
-
-    Patch from Gisle Aas <gisle@aas.no> to make DB_File export only the
-    O_* constants from Fcntl.
-
-    Removed the DESTROY method from the DB_File::HASHINFO module.
-
-    Previously DB_File hard-wired the class name of any object that it
-    created to "DB_File". This makes sub-classing difficult. Now
-    DB_File creats objects in the namespace of the package it has been
-    inherited into.
-
-
-1.14
-
-    Made it illegal to tie an associative array to a RECNO database and
-    an ordinary array to a HASH or BTREE database.
-
-1.13
-
-    Minor changes to DB_FIle.xs and DB_File.pm
-
-1.12
-
-    Documented the incompatibility with version 2 of Berkeley DB.
-
-1.11
-
-    Documented the untie gotcha.
-
-1.10
-
-    Fixed fd method so that it still returns -1 for in-memory files
-    when db 1.86 is used.
-
-1.09
-
-    Minor bug fix in DB_File::HASHINFO, DB_File::RECNOINFO and
-    DB_File::BTREEINFO.
-
-    Changed default mode to 0666.
-
-1.08
-
-    Documented operation of bval.
-
-1.07
-
-    Fixed bug with RECNO, where bval wasn't defaulting to "\n".
-
-1.06
-
-    Minor namespace cleanup: Localized PrintBtree.
-
-1.05
-
-    Made all scripts in the documentation strict and -w clean.
-
-    Added logic to DB_File.xs to allow the module to be built after
-    Perl is installed.
-
-1.04
-
-    Minor documentation changes.
-
-    Fixed a bug in hash_cb. Patches supplied by Dave Hammen,
-    <hammen@gothamcity.jsc.nasa.govt>.
-
-    Fixed a bug with the constructors for DB_File::HASHINFO,
-    DB_File::BTREEINFO and DB_File::RECNOINFO. Also tidied up the
-    constructors to make them -w clean.
-
-    Reworked part of the test harness to be more locale friendly.
-
-1.03
-
-    Documentation update.
-
-    DB_File now imports the constants (O_RDWR, O_CREAT etc.) from Fcntl
-    automatically.
-
-    The standard hash function exists is now supported.
-
-    Modified the behavior of get_dup. When it returns an associative
-    array, the value is the count of the number of matching BTREE
-    values.
-
-1.02
-
-    Merged OS/2 specific code into DB_File.xs
-
-    Removed some redundant code in DB_File.xs.
-
-    Documentation update.
-
-    Allow negative subscripts with RECNO interface.
-
-    Changed the default flags from O_RDWR to O_CREAT|O_RDWR.
-
-    The example code which showed how to lock a database needed a call
-    to sync added. Without it the resultant database file was empty.
-
-    Added get_dup method.
-
-1.01
-
-    Fixed a core dump problem with SunOS.
-
-    The return value from TIEHASH wasn't set to NULL when dbopen
-    returned an error.
-
-1.0
-
-    DB_File has been in use for over a year. To reflect that, the
-    version number has been incremented to 1.0.
-
-    Added complete support for multiple concurrent callbacks.
-
-    Using the push method on an empty list didn't work properly. This
-    has been fixed.
-
-0.3
-
-    Added prototype support for multiple btree compare callbacks.
-
-0.2
-
-    When DB_File is opening a database file it no longer terminates the
-    process if dbopen returned an error. This allows file protection
-    errors to be caught at run time. Thanks to Judith Grass
-    <grass@cybercash.com> for spotting the bug.
-
-0.1
-
-    First Release.
-
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
deleted file mode 100644
index 86d0b19888..0000000000
--- a/ext/DB_File/DB_File.pm
+++ /dev/null
@@ -1,2299 +0,0 @@
-# DB_File.pm -- Perl 5 interface to Berkeley DB 
-#
-# written by Paul Marquess (pmqs@cpan.org)
-# last modified 28th October 2007
-# version 1.818
-#
-#     Copyright (c) 1995-2009 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.
-
-
-package DB_File::HASHINFO ;
-
-require 5.00404;
-
-use warnings;
-use strict;
-use Carp;
-require Tie::Hash;
-@DB_File::HASHINFO::ISA = qw(Tie::Hash);
-
-sub new
-{
-    my $pkg = shift ;
-    my %x ;
-    tie %x, $pkg ;
-    bless \%x, $pkg ;
-}
-
-
-sub TIEHASH
-{
-    my $pkg = shift ;
-
-    bless { VALID => { 
-		       	bsize	  => 1,
-			ffactor	  => 1,
-			nelem	  => 1,
-			cachesize => 1,
-			hash	  => 2,
-			lorder	  => 1,
-		     }, 
-	    GOT   => {}
-          }, $pkg ;
-}
-
-
-sub FETCH 
-{  
-    my $self  = shift ;
-    my $key   = shift ;
-
-    return $self->{GOT}{$key} if exists $self->{VALID}{$key}  ;
-
-    my $pkg = ref $self ;
-    croak "${pkg}::FETCH - Unknown element '$key'" ;
-}
-
-
-sub STORE 
-{
-    my $self  = shift ;
-    my $key   = shift ;
-    my $value = shift ;
-
-    my $type = $self->{VALID}{$key};
-
-    if ( $type )
-    {
-    	croak "Key '$key' not associated with a code reference" 
-	    if $type == 2 && !ref $value && ref $value ne 'CODE';
-        $self->{GOT}{$key} = $value ;
-        return ;
-    }
-    
-    my $pkg = ref $self ;
-    croak "${pkg}::STORE - Unknown element '$key'" ;
-}
-
-sub DELETE 
-{
-    my $self = shift ;
-    my $key  = shift ;
-
-    if ( exists $self->{VALID}{$key} )
-    {
-        delete $self->{GOT}{$key} ;
-        return ;
-    }
-    
-    my $pkg = ref $self ;
-    croak "DB_File::HASHINFO::DELETE - Unknown element '$key'" ;
-}
-
-sub EXISTS
-{
-    my $self = shift ;
-    my $key  = shift ;
-
-    exists $self->{VALID}{$key} ;
-}
-
-sub NotHere
-{
-    my $self = shift ;
-    my $method = shift ;
-
-    croak ref($self) . " does not define the method ${method}" ;
-}
-
-sub FIRSTKEY { my $self = shift ; $self->NotHere("FIRSTKEY") }
-sub NEXTKEY  { my $self = shift ; $self->NotHere("NEXTKEY") }
-sub CLEAR    { my $self = shift ; $self->NotHere("CLEAR") }
-
-package DB_File::RECNOINFO ;
-
-use warnings;
-use strict ;
-
-@DB_File::RECNOINFO::ISA = qw(DB_File::HASHINFO) ;
-
-sub TIEHASH
-{
-    my $pkg = shift ;
-
-    bless { VALID => { map {$_, 1} 
-		       qw( bval cachesize psize flags lorder reclen bfname )
-		     },
-	    GOT   => {},
-          }, $pkg ;
-}
-
-package DB_File::BTREEINFO ;
-
-use warnings;
-use strict ;
-
-@DB_File::BTREEINFO::ISA = qw(DB_File::HASHINFO) ;
-
-sub TIEHASH
-{
-    my $pkg = shift ;
-
-    bless { VALID => { 
-		      	flags	   => 1,
-			cachesize  => 1,
-			maxkeypage => 1,
-			minkeypage => 1,
-			psize	   => 1,
-			compare	   => 2,
-			prefix	   => 2,
-			lorder	   => 1,
-	    	     },
-	    GOT   => {},
-          }, $pkg ;
-}
-
-
-package DB_File ;
-
-use warnings;
-use strict;
-our ($VERSION, @ISA, @EXPORT, $AUTOLOAD, $DB_BTREE, $DB_HASH, $DB_RECNO);
-our ($db_version, $use_XSLoader, $splice_end_array, $Error);
-use Carp;
-
-
-$VERSION = "1.820" ;
-$VERSION = eval $VERSION; # needed for dev releases
-
-{
-    local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
-    my @a =(1); splice(@a, 3);
-    $splice_end_array = 
-        ($splice_end_array =~ /^splice\(\) offset past end of array at /);
-}      
-
-#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE;
-$DB_BTREE = new DB_File::BTREEINFO ;
-$DB_HASH  = new DB_File::HASHINFO ;
-$DB_RECNO = new DB_File::RECNOINFO ;
-
-require Tie::Hash;
-require Exporter;
-use AutoLoader;
-BEGIN {
-    $use_XSLoader = 1 ;
-    { local $SIG{__DIE__} ; eval { require XSLoader } ; }
-
-    if ($@) {
-        $use_XSLoader = 0 ;
-        require DynaLoader;
-        @ISA = qw(DynaLoader);
-    }
-}
-
-push @ISA, qw(Tie::Hash Exporter);
-@EXPORT = qw(
-        $DB_BTREE $DB_HASH $DB_RECNO 
-
-	BTREEMAGIC
-	BTREEVERSION
-	DB_LOCK
-	DB_SHMEM
-	DB_TXN
-	HASHMAGIC
-	HASHVERSION
-	MAX_PAGE_NUMBER
-	MAX_PAGE_OFFSET
-	MAX_REC_NUMBER
-	RET_ERROR
-	RET_SPECIAL
-	RET_SUCCESS
-	R_CURSOR
-	R_DUP
-	R_FIRST
-	R_FIXEDLEN
-	R_IAFTER
-	R_IBEFORE
-	R_LAST
-	R_NEXT
-	R_NOKEY
-	R_NOOVERWRITE
-	R_PREV
-	R_RECNOSYNC
-	R_SETCURSOR
-	R_SNAPSHOT
-	__R_UNUSED
-
-);
-
-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};
-}           
-
-
-eval {
-    # Make all Fcntl O_XXX constants available for importing
-    require Fcntl;
-    my @O = grep /^O_/, @Fcntl::EXPORT;
-    Fcntl->import(@O);  # first we import what we want to export
-    push(@EXPORT, @O);
-};
-
-if ($use_XSLoader)
-  { XSLoader::load("DB_File", $VERSION)}
-else
-  { bootstrap DB_File $VERSION }
-
-# Preloaded methods go here.  Autoload methods go after __END__, and are
-# processed by the autosplit program.
-
-sub tie_hash_or_array
-{
-    my (@arg) = @_ ;
-    my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
-
-    use File::Spec;
-    $arg[1] = File::Spec->rel2abs($arg[1]) 
-        if defined $arg[1] ;
-
-    $arg[4] = tied %{ $arg[4] } 
-	if @arg >= 5 && ref $arg[4] && $arg[4] =~ /=HASH/ && tied %{ $arg[4] } ;
-
-    $arg[2] = O_CREAT()|O_RDWR() if @arg >=3 && ! defined $arg[2];
-    $arg[3] = 0666               if @arg >=4 && ! defined $arg[3];
-
-    # make recno in Berkeley DB version 2 (or better) work like 
-    # recno in version 1.
-    if ($db_version >= 4 and ! $tieHASH) {
-        $arg[2] |= O_CREAT();
-    }
-
-    if ($db_version > 1 and defined $arg[4] and $arg[4] =~ /RECNO/ and 
-	$arg[1] and ! -e $arg[1]) {
-	open(FH, ">$arg[1]") or return undef ;
-	close FH ;
-	chmod $arg[3] ? $arg[3] : 0666 , $arg[1] ;
-    }
-
-    DoTie_($tieHASH, @arg) ;
-}
-
-sub TIEHASH
-{
-    tie_hash_or_array(@_) ;
-}
-
-sub TIEARRAY
-{
-    tie_hash_or_array(@_) ;
-}
-
-sub CLEAR 
-{
-    my $self = shift;
-    my $key = 0 ;
-    my $value = "" ;
-    my $status = $self->seq($key, $value, R_FIRST());
-    my @keys;
- 
-    while ($status == 0) {
-        push @keys, $key;
-        $status = $self->seq($key, $value, R_NEXT());
-    }
-    foreach $key (reverse @keys) {
-        my $s = $self->del($key); 
-    }
-}
-
-sub EXTEND { }
-
-sub STORESIZE
-{
-    my $self = shift;
-    my $length = shift ;
-    my $current_length = $self->length() ;
-
-    if ($length < $current_length) {
-	my $key ;
-        for ($key = $current_length - 1 ; $key >= $length ; -- $key)
-	  { $self->del($key) }
-    }
-    elsif ($length > $current_length) {
-        $self->put($length-1, "") ;
-    }
-}
- 
-
-sub SPLICE
-{
-    my $self = shift;
-    my $offset = shift;
-    if (not defined $offset) {
-	warnings::warnif('uninitialized', 'Use of uninitialized value in splice');
-	$offset = 0;
-    }
-
-    my $length = @_ ? shift : 0;
-    # Carping about definedness comes _after_ the OFFSET sanity check.
-    # This is so we get the same error messages as Perl's splice().
-    # 
-
-    my @list = @_;
-
-    my $size = $self->FETCHSIZE();
-    
-    # 'If OFFSET is negative then it start that far from the end of
-    # the array.'
-    # 
-    if ($offset < 0) {
-	my $new_offset = $size + $offset;
-	if ($new_offset < 0) {
-	    die "Modification of non-creatable array value attempted, "
-	      . "subscript $offset";
-	}
-	$offset = $new_offset;
-    }
-
-    if (not defined $length) {
-	warnings::warnif('uninitialized', 'Use of uninitialized value in splice');
-	$length = 0;
-    }
-
-    if ($offset > $size) {
- 	$offset = $size;
-	warnings::warnif('misc', 'splice() offset past end of array')
-            if $splice_end_array;
-    }
-
-    # 'If LENGTH is omitted, removes everything from OFFSET onward.'
-    if (not defined $length) {
-	$length = $size - $offset;
-    }
-
-    # 'If LENGTH is negative, leave that many elements off the end of
-    # the array.'
-    # 
-    if ($length < 0) {
-	$length = $size - $offset + $length;
-
-	if ($length < 0) {
-	    # The user must have specified a length bigger than the
-	    # length of the array passed in.  But perl's splice()
-	    # doesn't catch this, it just behaves as for length=0.
-	    # 
-	    $length = 0;
-	}
-    }
-
-    if ($length > $size - $offset) {
-	$length = $size - $offset;
-    }
-
-    # $num_elems holds the current number of elements in the database.
-    my $num_elems = $size;
-
-    # 'Removes the elements designated by OFFSET and LENGTH from an
-    # array,'...
-    # 
-    my @removed = ();
-    foreach (0 .. $length - 1) {
-	my $old;
-	my $status = $self->get($offset, $old);
-	if ($status != 0) {
-	    my $msg = "error from Berkeley DB on get($offset, \$old)";
-	    if ($status == 1) {
-		$msg .= ' (no such element?)';
-	    }
-	    else {
-		$msg .= ": error status $status";
-		if (defined $! and $! ne '') {
-		    $msg .= ", message $!";
-		}
-	    }
-	    die $msg;
-	}
-	push @removed, $old;
-
-	$status = $self->del($offset);
-	if ($status != 0) {
-	    my $msg = "error from Berkeley DB on del($offset)";
-	    if ($status == 1) {
-		$msg .= ' (no such element?)';
-	    }
-	    else {
-		$msg .= ": error status $status";
-		if (defined $! and $! ne '') {
-		    $msg .= ", message $!";
-		}
-	    }
-	    die $msg;
-	}
-
-	-- $num_elems;
-    }
-
-    # ...'and replaces them with the elements of LIST, if any.'
-    my $pos = $offset;
-    while (defined (my $elem = shift @list)) {
-	my $old_pos = $pos;
-	my $status;
-	if ($pos >= $num_elems) {
-	    $status = $self->put($pos, $elem);
-	}
-	else {
-	    $status = $self->put($pos, $elem, $self->R_IBEFORE);
-	}
-
-	if ($status != 0) {
-	    my $msg = "error from Berkeley DB on put($pos, $elem, ...)";
-	    if ($status == 1) {
-		$msg .= ' (no such element?)';
-	    }
-	    else {
-		$msg .= ", error status $status";
-		if (defined $! and $! ne '') {
-		    $msg .= ", message $!";
-		}
-	    }
-	    die $msg;
-	}
-
-	die "pos unexpectedly changed from $old_pos to $pos with R_IBEFORE"
-	  if $old_pos != $pos;
-
-	++ $pos;
-	++ $num_elems;
-    }
-
-    if (wantarray) {
-	# 'In list context, returns the elements removed from the
-	# array.'
-	# 
-	return @removed;
-    }
-    elsif (defined wantarray and not wantarray) {
-	# 'In scalar context, returns the last element removed, or
-	# undef if no elements are removed.'
-	# 
-	if (@removed) {
-	    my $last = pop @removed;
-	    return "$last";
-	}
-	else {
-	    return undef;
-	}
-    }
-    elsif (not defined wantarray) {
-	# Void context
-    }
-    else { die }
-}
-sub ::DB_File::splice { &SPLICE }
-
-sub find_dup
-{
-    croak "Usage: \$db->find_dup(key,value)\n"
-        unless @_ == 3 ;
- 
-    my $db        = shift ;
-    my ($origkey, $value_wanted) = @_ ;
-    my ($key, $value) = ($origkey, 0);
-    my ($status) = 0 ;
-
-    for ($status = $db->seq($key, $value, R_CURSOR() ) ;
-         $status == 0 ;
-         $status = $db->seq($key, $value, R_NEXT() ) ) {
-
-        return 0 if $key eq $origkey and $value eq $value_wanted ;
-    }
-
-    return $status ;
-}
-
-sub del_dup
-{
-    croak "Usage: \$db->del_dup(key,value)\n"
-        unless @_ == 3 ;
- 
-    my $db        = shift ;
-    my ($key, $value) = @_ ;
-    my ($status) = $db->find_dup($key, $value) ;
-    return $status if $status != 0 ;
-
-    $status = $db->del($key, R_CURSOR() ) ;
-    return $status ;
-}
-
-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 ;
- 
-    # iterate through the database until either EOF ($status == 0)
-    # or a different key is encountered ($key ne $origkey).
-    for ($status = $db->seq($key, $value, R_CURSOR()) ;
-	 $status == 0 and $key eq $origkey ;
-         $status = $db->seq($key, $value, R_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) ;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DB_File - Perl5 access to Berkeley DB version 1.x
-
-=head1 SYNOPSIS
-
- use DB_File;
-
- [$X =] tie %hash,  'DB_File', [$filename, $flags, $mode, $DB_HASH] ;
- [$X =] tie %hash,  'DB_File', $filename, $flags, $mode, $DB_BTREE ;
- [$X =] tie @array, 'DB_File', $filename, $flags, $mode, $DB_RECNO ;
-
- $status = $X->del($key [, $flags]) ;
- $status = $X->put($key, $value [, $flags]) ;
- $status = $X->get($key, $value [, $flags]) ;
- $status = $X->seq($key, $value, $flags) ;
- $status = $X->sync([$flags]) ;
- $status = $X->fd ;
-
- # BTREE only
- $count = $X->get_dup($key) ;
- @list  = $X->get_dup($key) ;
- %list  = $X->get_dup($key, 1) ;
- $status = $X->find_dup($key, $value) ;
- $status = $X->del_dup($key, $value) ;
-
- # RECNO only
- $a = $X->length;
- $a = $X->pop ;
- $X->push(list);
- $a = $X->shift;
- $X->unshift(list);
- @r = $X->splice(offset, length, elements);
-
- # 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 { ... } ) ;
-
- untie %hash ;
- untie @array ;
-
-=head1 DESCRIPTION
-
-B<DB_File> is a module which allows Perl programs to make use of the
-facilities provided by Berkeley DB version 1.x (if you have a newer
-version of DB, see L<Using DB_File with Berkeley DB version 2 or greater>).
-It is assumed that you have a copy of the Berkeley DB manual pages at
-hand when reading this documentation. The interface defined here
-mirrors the Berkeley DB interface closely.
-
-Berkeley DB is a C library which provides a consistent interface to a
-number of database formats.  B<DB_File> provides an interface to all
-three of the database types currently supported by Berkeley DB.
-
-The file types are:
-
-=over 5
-
-=item B<DB_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 DB_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 Berkeley DB. If you do need to use your own
-hashing algorithm it is possible to write your own in Perl and have
-B<DB_File> use it instead.
-
-=item B<DB_BTREE>
-
-The btree format allows arbitrary key/value pairs to be stored in a
-sorted, balanced binary tree.
-
-As with the DB_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<DB_RECNO>
-
-DB_RECNO allows both fixed-length and variable-length flat text files
-to be manipulated using the same key/value pair interface as in DB_HASH
-and DB_BTREE.  In this case the key will consist of a record (line)
-number.
-
-=back
-
-=head2 Using DB_File with Berkeley DB version 2 or greater
-
-Although B<DB_File> is intended to be used with Berkeley DB version 1,
-it can also be used with version 2, 3 or 4. In this case the interface is
-limited to the functionality provided by Berkeley DB 1.x. Anywhere the
-version 2 or greater interface differs, B<DB_File> arranges for it to work
-like version 1. This feature allows B<DB_File> scripts that were built
-with version 1 to be migrated to version 2 or greater without any changes.
-
-If you want to make use of the new features available in Berkeley DB
-2.x or greater, use the Perl module B<BerkeleyDB> instead.
-
-B<Note:> The database file format has changed multiple times in Berkeley
-DB version 2, 3 and 4. If you cannot recreate your databases, you
-must dump any existing databases with either the C<db_dump> or the
-C<db_dump185> utility that comes with Berkeley DB.
-Once you have rebuilt DB_File to use Berkeley DB version 2 or greater,
-your databases can be recreated using C<db_load>. Refer to the Berkeley DB
-documentation for further details.
-
-Please read L<"COPYRIGHT"> before using version 2.x or greater of Berkeley
-DB with DB_File.
-
-=head2 Interface to Berkeley DB
-
-B<DB_File> allows access to Berkeley DB files using the tie() mechanism
-in Perl 5 (for full details, see L<perlfunc/tie()>). This facility
-allows B<DB_File> to access Berkeley DB files using either an
-associative array (for DB_HASH & DB_BTREE file types) or an ordinary
-array (for the DB_RECNO file type).
-
-In addition to the tie() interface, it is also possible to access most
-of the functions provided in the Berkeley DB API directly.
-See L<THE API INTERFACE>.
-
-=head2 Opening a Berkeley DB Database File
-
-Berkeley DB uses the function dbopen() to open or create a database.
-Here is the C prototype for dbopen():
-
-      DB*
-      dbopen (const char * file, int flags, int mode, 
-              DBTYPE type, const void * openinfo)
-
-The parameter C<type> is an enumeration which specifies which of the 3
-interface methods (DB_HASH, DB_BTREE or DB_RECNO) is to be used.
-Depending on which of these is actually chosen, the final parameter,
-I<openinfo> points to a data structure which allows tailoring of the
-specific interface method.
-
-This interface is handled slightly differently in B<DB_File>. Here is
-an equivalent call using B<DB_File>:
-
-        tie %array, 'DB_File', $filename, $flags, $mode, $DB_HASH ;
-
-The C<filename>, C<flags> and C<mode> parameters are the direct
-equivalent of their dbopen() counterparts. The final parameter $DB_HASH
-performs the function of both the C<type> and C<openinfo> parameters in
-dbopen().
-
-In the example above $DB_HASH is actually a pre-defined reference to a
-hash object. B<DB_File> has three of these pre-defined references.
-Apart from $DB_HASH, there is also $DB_BTREE and $DB_RECNO.
-
-The keys allowed in each of these pre-defined references is limited to
-the names used in the equivalent C structure. So, for example, the
-$DB_HASH reference will only allow keys called C<bsize>, C<cachesize>,
-C<ffactor>, C<hash>, C<lorder> and C<nelem>. 
-
-To change one of these elements, just assign to it like this:
-
-	$DB_HASH->{'cachesize'} = 10000 ;
-
-The three predefined variables $DB_HASH, $DB_BTREE and $DB_RECNO are
-usually adequate for most applications.  If you do need to create extra
-instances of these objects, constructors are available for each file
-type.
-
-Here are examples of the constructors and the valid options available
-for DB_HASH, DB_BTREE and DB_RECNO respectively.
-
-     $a = new DB_File::HASHINFO ;
-     $a->{'bsize'} ;
-     $a->{'cachesize'} ;
-     $a->{'ffactor'};
-     $a->{'hash'} ;
-     $a->{'lorder'} ;
-     $a->{'nelem'} ;
-
-     $b = new DB_File::BTREEINFO ;
-     $b->{'flags'} ;
-     $b->{'cachesize'} ;
-     $b->{'maxkeypage'} ;
-     $b->{'minkeypage'} ;
-     $b->{'psize'} ;
-     $b->{'compare'} ;
-     $b->{'prefix'} ;
-     $b->{'lorder'} ;
-
-     $c = new DB_File::RECNOINFO ;
-     $c->{'bval'} ;
-     $c->{'cachesize'} ;
-     $c->{'psize'} ;
-     $c->{'flags'} ;
-     $c->{'lorder'} ;
-     $c->{'reclen'} ;
-     $c->{'bfname'} ;
-
-The values stored in the hashes above are mostly the direct equivalent
-of their C counterpart. Like their C counterparts, all are set to a
-default values - that means you don't have to set I<all> of the
-values when you only want to change one. Here is an example:
-
-     $a = new DB_File::HASHINFO ;
-     $a->{'cachesize'} =  12345 ;
-     tie %y, 'DB_File', "filename", $flags, 0777, $a ;
-
-A few of the options need extra discussion here. When used, the C
-equivalent of the keys C<hash>, C<compare> and C<prefix> store pointers
-to C functions. In B<DB_File> these keys are used to store references
-to Perl subs. Below are templates for each of the subs:
-
-    sub hash
-    {
-        my ($data) = @_ ;
-        ...
-        # return the hash value for $data
-	return $hash ;
-    }
-
-    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) ;
-    }
-
-    sub prefix
-    {
-	my ($key, $key2) = @_ ;
-        ...
-        # return number of bytes of $key2 which are 
-        # necessary to determine that it is greater than $key1
-        return $bytes ;
-    }
-
-See L<Changing the BTREE sort order> for an example of using the
-C<compare> template.
-
-If you are using the DB_RECNO interface and you intend making use of
-C<bval>, you should check out L<The 'bval' Option>.
-
-=head2 Default Parameters
-
-It is possible to omit some or all of the final 4 parameters in the
-call to C<tie> and let them take default values. As DB_HASH is the most
-common file format used, the call:
-
-    tie %A, "DB_File", "filename" ;
-
-is equivalent to:
-
-    tie %A, "DB_File", "filename", O_CREAT|O_RDWR, 0666, $DB_HASH ;
-
-It is also possible to omit the filename parameter as well, so the
-call:
-
-    tie %A, "DB_File" ;
-
-is equivalent to:
-
-    tie %A, "DB_File", undef, O_CREAT|O_RDWR, 0666, $DB_HASH ;
-
-See L<In Memory Databases> for a discussion on the use of C<undef>
-in place of a filename.
-
-=head2 In Memory Databases
-
-Berkeley DB allows the creation of in-memory databases by using NULL
-(that is, a C<(char *)0> in C) in place of the filename.  B<DB_File>
-uses C<undef> instead of NULL to provide this functionality.
-
-=head1 DB_HASH
-
-The DB_HASH file format is probably the most commonly used of the three
-file formats that B<DB_File> supports. It is also very straightforward
-to use.
-
-=head2 A Simple Example
-
-This example shows how to create a database, add key/value pairs to the
-database, delete keys/value pairs and finally how to enumerate the
-contents of the database.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    our (%h, $k, $v) ;
-
-    unlink "fruit" ;
-    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0666, $DB_HASH 
-        or die "Cannot open file 'fruit': $!\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 is in an apparently random order.
-
-=head1 DB_BTREE
-
-The DB_BTREE format is useful when you want to store data in a given
-order. By default the keys will be stored in lexical order, but as you
-will see from the example shown in the next section, it is very easy to
-define your own sorting function.
-
-=head2 Changing the BTREE sort order
-
-This script shows how to override the default sorting algorithm that
-BTREE uses. Instead of using the normal lexical ordering, a case
-insensitive compare function will be used.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my %h ;
-
-    sub Compare
-    {
-        my ($key1, $key2) = @_ ;
-        "\L$key1" cmp "\L$key2" ;
-    }
-
-    # specify the Perl sub that will do the comparison
-    $DB_BTREE->{'compare'} = \&Compare ;
-
-    unlink "tree" ;
-    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0666, $DB_BTREE 
-        or die "Cannot open file 'tree': $!\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.
-
-=item 3
-
-Duplicate keys are entirely defined by the comparison function.
-In the case-insensitive example above, the keys: 'KEY' and 'key'
-would be considered duplicates, and assigning to the second one
-would overwrite the first. If duplicates are allowed for (with the
-R_DUP flag discussed below), only a single copy of duplicate keys
-is stored in the database --- so (again with example above) assigning
-three values to the keys: 'KEY', 'Key', and 'key' would leave just
-the first key: 'KEY' in the database with three values. For some
-situations this results in information loss, so care should be taken
-to provide fully qualified comparison functions when necessary.
-For example, the above comparison routine could be modified to
-additionally compare case-sensitively if two keys are equal in the
-case insensitive comparison:
-
-    sub compare {
-        my($key1, $key2) = @_;
-        lc $key1 cmp lc $key2 ||
-        $key1 cmp $key2;
-    }
-
-And now you will only have duplicates when the keys themselves
-are truly the same. (note: in versions of the db library prior to
-about November 1996, such duplicate keys were retained so it was
-possible to recover the original keys in sets of keys that
-compared as equal).
-
-
-=back 
-
-=head2 Handling Duplicate Keys 
-
-The BTREE file type optionally allows a single key to be associated
-with an arbitrary number of values. This option is enabled by setting
-the flags element of C<$DB_BTREE> to R_DUP when creating the database.
-
-There are some difficulties in using the tied hash interface if you
-want to manipulate a BTREE database with duplicate keys. Consider this
-code:
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, %h) ;
-
-    $filename = "tree" ;
-    unlink $filename ;
-
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
-
-    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
-
-    # iterate through the associative array
-    # and print each key/value pair.
-    foreach (sort keys %h)
-      { print "$_  -> $h{$_}\n" }
-
-    untie %h ;
-
-Here is the output:
-
-    Smith   -> John
-    Wall    -> Larry
-    Wall    -> Larry
-    Wall    -> Larry
-    mouse   -> mickey
-
-As you can see 3 records have been successfully created with key C<Wall>
-- the only thing is, when they are retrieved from the database they
-I<seem> to have the same value, namely C<Larry>. The problem is caused
-by the way that the associative array interface works. Basically, when
-the associative array interface is used to fetch the value associated
-with a given key, it will only ever retrieve the first value.
-
-Although it may not be immediately obvious from the code above, the
-associative array interface can be used to write values with duplicate
-keys, but it cannot be used to read them back from the database.
-
-The way to get around this problem is to use the Berkeley DB API method
-called C<seq>.  This method allows sequential access to key/value
-pairs. See L<THE API INTERFACE> for details of both the C<seq> method
-and the API in general.
-
-Here is the script above rewritten using the C<seq> API method.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, $x, %h, $status, $key, $value) ;
-
-    $filename = "tree" ;
-    unlink $filename ;
-
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
-
-    # iterate through the btree using seq
-    # and print each key/value pair.
-    $key = $value = 0 ;
-    for ($status = $x->seq($key, $value, R_FIRST) ;
-         $status == 0 ;
-         $status = $x->seq($key, $value, R_NEXT) )
-      {  print "$key -> $value\n" }
-
-    undef $x ;
-    untie %h ;
-
-that prints:
-
-    Smith   -> John
-    Wall    -> Brick
-    Wall    -> Brick
-    Wall    -> Larry
-    mouse   -> mickey
-
-This time we have got all the key/value pairs, including the multiple
-values associated with the key C<Wall>.
-
-To make life easier when dealing with duplicate keys, B<DB_File> comes with 
-a few utility methods.
-
-=head2 The get_dup() Method
-
-The C<get_dup> method assists in
-reading duplicate values from BTREE databases. The method can take the
-following forms:
-
-    $count = $x->get_dup($key) ;
-    @list  = $x->get_dup($key) ;
-    %list  = $x->get_dup($key, 1) ;
-
-In a scalar context the method returns the number of values associated
-with the key, C<$key>.
-
-In list context, it returns all the values which match C<$key>. Note
-that the values will be returned in an apparently random order.
-
-In list context, if the second parameter is present and evaluates
-TRUE, the method returns an associative array. The keys of the
-associative array correspond to the values that matched in the BTREE
-and the values of the array are a count of the number of times that
-particular value occurred in the BTREE.
-
-So assuming the database created above, we can use C<get_dup> like
-this:
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, $x, %h) ;
-
-    $filename = "tree" ;
-
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    my $cnt  = $x->get_dup("Wall") ;
-    print "Wall occurred $cnt times\n" ;
-
-    my %hash = $x->get_dup("Wall", 1) ;
-    print "Larry is there\n" if $hash{'Larry'} ;
-    print "There are $hash{'Brick'} Brick Walls\n" ;
-
-    my @list = sort $x->get_dup("Wall") ;
-    print "Wall =>	[@list]\n" ;
-
-    @list = $x->get_dup("Smith") ;
-    print "Smith =>	[@list]\n" ;
-
-    @list = $x->get_dup("Dog") ;
-    print "Dog =>	[@list]\n" ;
-
-
-and it will print:
-
-    Wall occurred 3 times
-    Larry is there
-    There are 2 Brick Walls
-    Wall =>	[Brick Brick Larry]
-    Smith =>	[John]
-    Dog =>	[]
-
-=head2 The find_dup() Method
-
-    $status = $X->find_dup($key, $value) ;
-
-This method checks for the existence of a specific key/value pair. If the
-pair exists, the cursor is left pointing to the pair and the method 
-returns 0. Otherwise the method returns a non-zero value.
-
-Assuming the database from the previous example:
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, $x, %h, $found) ;
-
-    $filename = "tree" ;
-
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-
-    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
-    print "Harry Wall is $found there\n" ;
-
-    undef $x ;
-    untie %h ;
-
-prints this
-
-    Larry Wall is  there
-    Harry Wall is not there
-
-
-=head2 The del_dup() Method
-
-    $status = $X->del_dup($key, $value) ;
-
-This method deletes a specific key/value pair. It returns
-0 if they exist and have been deleted successfully.
-Otherwise the method returns a non-zero value.
-
-Again assuming the existence of the C<tree> database
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, $x, %h, $found) ;
-
-    $filename = "tree" ;
-
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    $x->del_dup("Wall", "Larry") ;
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-
-    undef $x ;
-    untie %h ;
-
-prints this
-
-    Larry Wall is not there
-
-=head2 Matching Partial Keys 
-
-The BTREE interface has a feature which allows partial keys to be
-matched. This functionality is I<only> available when the C<seq> method
-is used along with the R_CURSOR flag.
-
-    $x->seq($key, $value, R_CURSOR) ;
-
-Here is the relevant quote from the dbopen man page where it defines
-the use of the R_CURSOR flag with seq:
-
-    Note, for the DB_BTREE access method, the returned key is not
-    necessarily an exact match for the specified key. The returned key
-    is the smallest key greater than or equal to the specified key,
-    permitting partial key matches and range searches.
-
-In the example script below, the C<match> sub uses this feature to find
-and print the first matching key/value pair given a partial key.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    use Fcntl ;
-
-    my ($filename, $x, %h, $st, $key, $value) ;
-
-    sub match
-    {
-        my $key = shift ;
-        my $value = 0;
-        my $orig_key = $key ;
-        $x->seq($key, $value, R_CURSOR) ;
-        print "$orig_key\t-> $key\t-> $value\n" ;
-    }
-
-    $filename = "tree" ;
-    unlink $filename ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE
-        or die "Cannot open $filename: $!\n";
-
-    # Add some key/value pairs to the file
-    $h{'mouse'} = 'mickey' ;
-    $h{'Wall'} = 'Larry' ;
-    $h{'Walls'} = 'Brick' ; 
-    $h{'Smith'} = 'John' ;
-
-
-    $key = $value = 0 ;
-    print "IN ORDER\n" ;
-    for ($st = $x->seq($key, $value, R_FIRST) ;
-	 $st == 0 ;
-         $st = $x->seq($key, $value, R_NEXT) )
-
-      {  print "$key	-> $value\n" }
-
-    print "\nPARTIAL MATCH\n" ;
-
-    match "Wa" ;
-    match "A" ;
-    match "a" ;
-
-    undef $x ;
-    untie %h ;
-
-Here is the output:
-
-    IN ORDER
-    Smith -> John
-    Wall  -> Larry
-    Walls -> Brick
-    mouse -> mickey
-
-    PARTIAL MATCH
-    Wa -> Wall  -> Larry
-    A  -> Smith -> John
-    a  -> mouse -> mickey
-
-=head1 DB_RECNO
-
-DB_RECNO provides an interface to flat text files. Both variable and
-fixed length records are supported.
-
-In order to make RECNO more compatible with Perl, the array offset for
-all RECNO arrays begins at 0 rather than 1 as in Berkeley DB.
-
-As with normal Perl arrays, a RECNO array can be accessed using
-negative indexes. The index -1 refers to the last element of the array,
--2 the second last, and so on. Attempting to access an element before
-the start of the array will raise a fatal run-time error.
-
-=head2 The 'bval' Option
-
-The operation of the bval option warrants some discussion. Here is the
-definition of bval from the Berkeley DB 1.85 recno manual page:
-
-    The delimiting byte to be used to mark  the  end  of  a
-    record for variable-length records, and the pad charac-
-    ter for fixed-length records.  If no  value  is  speci-
-    fied,  newlines  (``\n'')  are  used to mark the end of
-    variable-length records and  fixed-length  records  are
-    padded with spaces.
-
-The second sentence is wrong. In actual fact bval will only default to
-C<"\n"> when the openinfo parameter in dbopen is NULL. If a non-NULL
-openinfo parameter is used at all, the value that happens to be in bval
-will be used. That means you always have to specify bval when making
-use of any of the options in the openinfo parameter. This documentation
-error will be fixed in the next release of Berkeley DB.
-
-That clarifies the situation with regards Berkeley DB itself. What
-about B<DB_File>? Well, the behavior defined in the quote above is
-quite useful, so B<DB_File> conforms to it.
-
-That means that you can specify other options (e.g. cachesize) and
-still have bval default to C<"\n"> for variable length records, and
-space for fixed length records.
-
-Also note that the bval option only allows you to specify a single byte
-as a delimiter.
-
-=head2 A Simple 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 warnings ;
-    use strict ;
-    use DB_File ;
-
-    my $filename = "text" ;
-    unlink $filename ;
-
-    my @h ;
-    tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_RECNO 
-        or die "Cannot open file 'text': $!\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] ;
-
-    # use a negative index
-    print "The last element is $h[-1]\n" ;
-    print "The 2nd last element is $h[-2]\n" ;
-
-    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
-
-=head2 Extra RECNO Methods
-
-If you are using a version of Perl earlier than 5.004_57, the tied
-array interface is quite limited. In the example script above
-C<push>, C<pop>, C<shift>, C<unshift>
-or determining the array length will not work with a tied array.
-
-To make the interface more useful for older versions of Perl, a number
-of methods are supplied with B<DB_File> to simulate the missing array
-operations. All these methods are accessed via the object returned from
-the tie call.
-
-Here are the methods:
-
-=over 5
-
-=item B<$X-E<gt>push(list) ;>
-
-Pushes the elements of C<list> to the end of the array.
-
-=item B<$value = $X-E<gt>pop ;>
-
-Removes and returns the last element of the array.
-
-=item B<$X-E<gt>shift>
-
-Removes and returns the first element of the array.
-
-=item B<$X-E<gt>unshift(list) ;>
-
-Pushes the elements of C<list> to the start of the array.
-
-=item B<$X-E<gt>length>
-
-Returns the number of elements in the array.
-
-=item B<$X-E<gt>splice(offset, length, elements);>
-
-Returns a splice of the array.
-
-=back
-
-=head2 Another Example
-
-Here is a more complete example that makes use of some of the methods
-described above. It also makes use of the API interface directly (see 
-L<THE API INTERFACE>).
-
-    use warnings ;
-    use strict ;
-    my (@h, $H, $file, $i) ;
-    use DB_File ;
-    use Fcntl ;
-
-    $file = "text" ;
-
-    unlink $file ;
-
-    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0666, $DB_RECNO 
-        or die "Cannot open file $file: $!\n" ;
-
-    # first create a text file to play with
-    $h[0] = "zero" ;
-    $h[1] = "one" ;
-    $h[2] = "two" ;
-    $h[3] = "three" ;
-    $h[4] = "four" ;
-
-
-    # Print the records in order.
-    #
-    # The length method is needed here because evaluating a tied
-    # array in a scalar context does not return the number of
-    # elements in the array.  
-
-    print "\nORIGINAL\n" ;
-    foreach $i (0 .. $H->length - 1) {
-        print "$i: $h[$i]\n" ;
-    }
-
-    # use the push & pop methods
-    $a = $H->pop ;
-    $H->push("last") ;
-    print "\nThe last record was [$a]\n" ;
-
-    # and the shift & unshift methods
-    $a = $H->shift ;
-    $H->unshift("first") ;
-    print "The first record was [$a]\n" ;
-
-    # Use the API to add a new record after record 2.
-    $i = 2 ;
-    $H->put($i, "Newbie", R_IAFTER) ;
-
-    # and a new record before record 1.
-    $i = 1 ;
-    $H->put($i, "New One", R_IBEFORE) ;
-
-    # delete record 3
-    $H->del(3) ;
-
-    # now print the records in reverse order
-    print "\nREVERSE\n" ;
-    for ($i = $H->length - 1 ; $i >= 0 ; -- $i)
-      { print "$i: $h[$i]\n" }
-
-    # same again, but use the API functions instead
-    print "\nREVERSE again\n" ;
-    my ($s, $k, $v)  = (0, 0, 0) ;
-    for ($s = $H->seq($k, $v, R_LAST) ; 
-             $s == 0 ; 
-             $s = $H->seq($k, $v, R_PREV))
-      { print "$k: $v\n" }
-
-    undef $H ;
-    untie @h ;
-
-and this is what it outputs:
-
-    ORIGINAL
-    0: zero
-    1: one
-    2: two
-    3: three
-    4: four
-
-    The last record was [four]
-    The first record was [zero]
-
-    REVERSE
-    5: last
-    4: three
-    3: Newbie
-    2: one
-    1: New One
-    0: first
-
-    REVERSE again
-    5: last
-    4: three
-    3: Newbie
-    2: one
-    1: New One
-    0: first
-
-Notes:
-
-=over 5
-
-=item 1.
-
-Rather than iterating through the array, C<@h> like this:
-
-    foreach $i (@h)
-
-it is necessary to use either this:
-
-    foreach $i (0 .. $H->length - 1) 
-
-or this:
-
-    for ($a = $H->get($k, $v, R_FIRST) ;
-         $a == 0 ;
-         $a = $H->get($k, $v, R_NEXT) )
-
-=item 2.
-
-Notice that both times the C<put> method was used the record index was
-specified using a variable, C<$i>, rather than the literal value
-itself. This is because C<put> will return the record number of the
-inserted line via that parameter.
-
-=back
-
-=head1 THE API INTERFACE
-
-As well as accessing Berkeley DB using a tied hash or array, it is also
-possible to make direct use of most of the API functions defined in the
-Berkeley DB documentation.
-
-To do this you need to store a copy of the object returned from the tie.
-
-	$db = tie %hash, "DB_File", "filename" ;
-
-Once you have done that, you can access the Berkeley DB API functions
-as B<DB_File> methods directly like this:
-
-	$db->put($key, $value, R_NOOVERWRITE) ;
-
-B<Important:> If you have saved a copy of the object returned from
-C<tie>, the underlying database file will I<not> be closed until both
-the tied variable is untied and all copies of the saved object are
-destroyed. 
-
-    use DB_File ;
-    $db = tie %hash, "DB_File", "filename" 
-        or die "Cannot tie filename: $!" ;
-    ...
-    undef $db ;
-    untie %hash ;
-
-See L<The untie() Gotcha> for more details.
-
-All the functions defined in L<dbopen> are available except for
-close() and dbopen() itself. The B<DB_File> method interface to the
-supported functions have been implemented to mirror the way Berkeley DB
-works whenever possible. In particular note that:
-
-=over 5
-
-=item *
-
-The methods return a status value. All return 0 on success.
-All return -1 to signify an error and set C<$!> to the exact
-error code. The return code 1 generally (but not always) means that the
-key specified did not exist in the database.
-
-Other return codes are defined. See below and in the Berkeley DB
-documentation for details. The Berkeley DB documentation should be used
-as the definitive source.
-
-=item *
-
-Whenever a Berkeley DB function returns data via one of its parameters,
-the equivalent B<DB_File> method does exactly the same.
-
-=item *
-
-If you are careful, it is possible to mix API calls with the tied
-hash/array interface in the same piece of code. Although only a few of
-the methods used to implement the tied interface currently make use of
-the cursor, you should always assume that the cursor has been changed
-any time the tied hash/array interface is used. As an example, this
-code will probably not do what you expect:
-
-    $X = tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0777, $DB_BTREE
-        or die "Cannot tie $filename: $!" ;
-
-    # Get the first key/value pair and set  the cursor
-    $X->seq($key, $value, R_FIRST) ;
-
-    # this line will modify the cursor
-    $count = scalar keys %x ; 
-
-    # Get the second key/value pair.
-    # oops, it didn't, it got the last key/value pair!
-    $X->seq($key, $value, R_NEXT) ;
-
-The code above can be rearranged to get around the problem, like this:
-
-    $X = tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0777, $DB_BTREE
-        or die "Cannot tie $filename: $!" ;
-
-    # this line will modify the cursor
-    $count = scalar keys %x ; 
-
-    # Get the first key/value pair and set  the cursor
-    $X->seq($key, $value, R_FIRST) ;
-
-    # Get the second key/value pair.
-    # worked this time.
-    $X->seq($key, $value, R_NEXT) ;
-
-=back
-
-All the constants defined in L<dbopen> for use in the flags parameters
-in the methods defined below are also available. Refer to the Berkeley
-DB documentation for the precise meaning of the flags values.
-
-Below is a list of the methods available.
-
-=over 5
-
-=item B<$status = $X-E<gt>get($key, $value [, $flags]) ;>
-
-Given a key (C<$key>) this method reads the value associated with it
-from the database. The value read from the database is returned in the
-C<$value> parameter.
-
-If the key does not exist the method returns 1.
-
-No flags are currently defined for this method.
-
-=item B<$status = $X-E<gt>put($key, $value [, $flags]) ;>
-
-Stores the key/value pair in the database.
-
-If you use either the R_IAFTER or R_IBEFORE flags, the C<$key> parameter
-will have the record number of the inserted key/value pair set.
-
-Valid flags are R_CURSOR, R_IAFTER, R_IBEFORE, R_NOOVERWRITE and
-R_SETCURSOR.
-
-=item B<$status = $X-E<gt>del($key [, $flags]) ;>
-
-Removes all key/value pairs with key C<$key> from the database.
-
-A return code of 1 means that the requested key was not in the
-database.
-
-R_CURSOR is the only valid flag at present.
-
-=item B<$status = $X-E<gt>fd ;>
-
-Returns the file descriptor for the underlying database.
-
-See L<Locking: The Trouble with fd> for an explanation for why you should
-not use C<fd> to lock your database.
-
-=item B<$status = $X-E<gt>seq($key, $value, $flags) ;>
-
-This interface allows sequential retrieval from the database. See
-L<dbopen> for full details.
-
-Both the C<$key> and C<$value> parameters will be set to the key/value
-pair read from the database.
-
-The flags parameter is mandatory. The valid flag values are R_CURSOR,
-R_FIRST, R_LAST, R_NEXT and R_PREV.
-
-=item B<$status = $X-E<gt>sync([$flags]) ;>
-
-Flushes any cached buffers to disk.
-
-R_RECNOSYNC is the only valid flag at present.
-
-=back
-
-=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.
-
-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 warnings ;
-    use strict ;
-    use DB_File ;
-
-    my %hash ;
-    my $filename = "filt" ;
-    unlink $filename ;
-
-    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
-      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 warnings ;
-    use strict ;
-    use DB_File ;
-    my %hash ;
-    my $filename = "filt" ;
-    unlink $filename ;
-
-
-    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
-      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 HINTS AND TIPS 
-
-
-=head2 Locking: The Trouble with fd
-
-Until version 1.72 of this module, the recommended technique for locking
-B<DB_File> databases was to flock the filehandle returned from the "fd"
-function. Unfortunately this technique has been shown to be fundamentally
-flawed (Kudos to David Harris for tracking this down). Use it at your own
-peril!
-
-The locking technique went like this. 
-
-    $db = tie(%db, 'DB_File', 'foo.db', O_CREAT|O_RDWR, 0644)
-        || die "dbcreat foo.db $!";
-    $fd = $db->fd;
-    open(DB_FH, "+<&=$fd") || die "dup $!";
-    flock (DB_FH, LOCK_EX) || die "flock: $!";
-    ...
-    $db{"Tom"} = "Jerry" ;
-    ...
-    flock(DB_FH, LOCK_UN);
-    undef $db;
-    untie %db;
-    close(DB_FH);
-
-In simple terms, this is what happens:
-
-=over 5
-
-=item 1.
-
-Use "tie" to open the database.
-
-=item 2.
-
-Lock the database with fd & flock.
-
-=item 3.
-
-Read & Write to the database.
-
-=item 4.
-
-Unlock and close the database.
-
-=back
-
-Here is the crux of the problem. A side-effect of opening the B<DB_File>
-database in step 2 is that an initial block from the database will get
-read from disk and cached in memory.
-
-To see why this is a problem, consider what can happen when two processes,
-say "A" and "B", both want to update the same B<DB_File> database
-using the locking steps outlined above. Assume process "A" has already
-opened the database and has a write lock, but it hasn't actually updated
-the database yet (it has finished step 2, but not started step 3 yet). Now
-process "B" tries to open the same database - step 1 will succeed,
-but it will block on step 2 until process "A" releases the lock. The
-important thing to notice here is that at this point in time both
-processes will have cached identical initial blocks from the database.
-
-Now process "A" updates the database and happens to change some of the
-data held in the initial buffer. Process "A" terminates, flushing
-all cached data to disk and releasing the database lock. At this point
-the database on disk will correctly reflect the changes made by process
-"A".
-
-With the lock released, process "B" can now continue. It also updates the
-database and unfortunately it too modifies the data that was in its
-initial buffer. Once that data gets flushed to disk it will overwrite
-some/all of the changes process "A" made to the database.
-
-The result of this scenario is at best a database that doesn't contain
-what you expect. At worst the database will corrupt.
-
-The above won't happen every time competing process update the same
-B<DB_File> database, but it does illustrate why the technique should
-not be used.
-
-=head2 Safe ways to lock a database
-
-Starting with version 2.x, Berkeley DB  has internal support for locking.
-The companion module to this one, B<BerkeleyDB>, provides an interface
-to this locking functionality. If you are serious about locking
-Berkeley DB databases, I strongly recommend using B<BerkeleyDB>.
-
-If using B<BerkeleyDB> isn't an option, there are a number of modules
-available on CPAN that can be used to implement locking. Each one
-implements locking differently and has different goals in mind. It is
-therefore worth knowing the difference, so that you can pick the right
-one for your application. Here are the three locking wrappers:
-
-=over 5
-
-=item B<Tie::DB_Lock>
-
-A B<DB_File> wrapper which creates copies of the database file for
-read access, so that you have a kind of a multiversioning concurrent read
-system. However, updates are still serial. Use for databases where reads
-may be lengthy and consistency problems may occur.
-
-=item B<Tie::DB_LockFile> 
-
-A B<DB_File> wrapper that has the ability to lock and unlock the database
-while it is being used. Avoids the tie-before-flock problem by simply
-re-tie-ing the database when you get or drop a lock.  Because of the
-flexibility in dropping and re-acquiring the lock in the middle of a
-session, this can be massaged into a system that will work with long
-updates and/or reads if the application follows the hints in the POD
-documentation.
-
-=item B<DB_File::Lock> 
-
-An extremely lightweight B<DB_File> wrapper that simply flocks a lockfile
-before tie-ing the database and drops the lock after the untie. Allows
-one to use the same lockfile for multiple databases to avoid deadlock
-problems, if desired. Use for databases where updates are reads are
-quick and simple flock locking semantics are enough.
-
-=back
-
-=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<DBM FILTERS> for a generic way to work around this problem.
-
-Here is a real example. Netscape 2.0 keeps a record of the locations you
-visit along with the time you last visited them in a DB_HASH database.
-This is usually stored in the file F<~/.netscape/history.db>. The key
-field in the database is the location string and the value field is the
-time the location was last visited stored as a 4 byte binary value.
-
-If you haven't already guessed, the location string is stored with a
-terminating NULL. This means you need to be careful when accessing the
-database.
-
-Here is a snippet of code that is loosely based on Tom Christiansen's
-I<ggh> script (available from your nearest CPAN archive in
-F<authors/id/TOMC/scripts/nshist.gz>).
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    use Fcntl ;
-
-    my ($dotdir, $HISTORY, %hist_db, $href, $binary_time, $date) ;
-    $dotdir = $ENV{HOME} || $ENV{LOGNAME};
-
-    $HISTORY = "$dotdir/.netscape/history.db";
-
-    tie %hist_db, 'DB_File', $HISTORY
-        or die "Cannot open $HISTORY: $!\n" ;;
-
-    # Dump the complete database
-    while ( ($href, $binary_time) = each %hist_db ) {
-
-        # remove the terminating NULL
-        $href =~ s/\x00$// ;
-
-        # convert the binary time into a user friendly string
-        $date = localtime unpack("V", $binary_time);
-        print "$date $href\n" ;
-    }
-
-    # check for the existence of a specific key
-    # remember to add the NULL
-    if ( $binary_time = $hist_db{"http://mox.perl.com/\x00"} ) {
-        $date = localtime unpack("V", $binary_time) ;
-        print "Last visited mox.perl.com on $date\n" ;
-    }
-    else {
-        print "Never visited mox.perl.com\n"
-    }
-
-    untie %hist_db ;
-
-=head2 The untie() Gotcha
-
-If you make use of the Berkeley DB API, it is I<very> strongly
-recommended that you read L<perltie/The untie Gotcha>. 
-
-Even if you don't currently make use of the API interface, it is still
-worth reading it.
-
-Here is an example which illustrates the problem from a B<DB_File>
-perspective:
-
-    use DB_File ;
-    use Fcntl ;
-
-    my %x ;
-    my $X ;
-
-    $X = tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_TRUNC
-        or die "Cannot tie first time: $!" ;
-
-    $x{123} = 456 ;
-
-    untie %x ;
-
-    tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_CREAT
-        or die "Cannot tie second time: $!" ;
-
-    untie %x ;
-
-When run, the script will produce this error message:
-
-    Cannot tie second time: Invalid argument at bad.file line 14.
-
-Although the error message above refers to the second tie() statement
-in the script, the source of the problem is really with the untie()
-statement that precedes it.
-
-Having read L<perltie> you will probably have already guessed that the
-error is caused by the extra copy of the tied object stored in C<$X>.
-If you haven't, then the problem boils down to the fact that the
-B<DB_File> destructor, DESTROY, will not be called until I<all>
-references to the tied object are destroyed. Both the tied variable,
-C<%x>, and C<$X> above hold a reference to the object. The call to
-untie() will destroy the first, but C<$X> still holds a valid
-reference, so the destructor will not get called and the database file
-F<tst.fil> will remain open. The fact that Berkeley DB then reports the
-attempt to open a database that is already open via the catch-all
-"Invalid argument" doesn't help.
-
-If you run the script with the C<-w> flag the error message becomes:
-
-    untie attempted while 1 inner references still exist at bad.file line 12.
-    Cannot tie second time: Invalid argument at bad.file line 14.
-
-which pinpoints the real problem. Finally the script can now be
-modified to fix the original problem by destroying the API object
-before the untie:
-
-    ...
-    $x{123} = 456 ;
-
-    undef $X ;
-    untie %x ;
-
-    $X = tie %x, 'DB_File', 'tst.fil' , O_RDWR|O_CREAT
-    ...
-
-
-=head1 COMMON QUESTIONS
-
-=head2 Why is there Perl source in my database?
-
-If you look at the contents of a database file created by DB_File,
-there can sometimes be part of a Perl script included in it.
-
-This happens because Berkeley DB uses dynamic memory to allocate
-buffers which will subsequently be written to the database file. Being
-dynamic, the memory could have been used for anything before DB
-malloced it. As Berkeley DB doesn't clear the memory once it has been
-allocated, the unused portions will contain random junk. In the case
-where a Perl script gets written to the database, the random junk will
-correspond to an area of dynamic memory that happened to be used during
-the compilation of the script.
-
-Unless you don't like the possibility of there being part of your Perl
-scripts embedded in a database file, this is nothing to worry about.
-
-=head2 How do I store complex data structures with DB_File?
-
-Although B<DB_File> cannot do this directly, there is a module which
-can layer transparently over B<DB_File> to accomplish this feat.
-
-Check out the MLDBM module, available on CPAN in the directory
-F<modules/by-module/MLDBM>.
-
-=head2 What does "Invalid Argument" mean?
-
-You will get this error message when one of the parameters in the
-C<tie> call is wrong. Unfortunately there are quite a few parameters to
-get wrong, so it can be difficult to figure out which one it is.
-
-Here are a couple of possibilities:
-
-=over 5
-
-=item 1.
-
-Attempting to reopen a database without closing it. 
-
-=item 2.
-
-Using the O_WRONLY flag.
-
-=back
-
-=head2 What does "Bareword 'DB_File' not allowed" mean? 
-
-You will encounter this particular error message when you have the
-C<strict 'subs'> pragma (or the full strict pragma) in your script.
-Consider this script:
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    my %x ;
-    tie %x, DB_File, "filename" ;
-
-Running it produces the error in question:
-
-    Bareword "DB_File" not allowed while "strict subs" in use 
-
-To get around the error, place the word C<DB_File> in either single or
-double quotes, like this:
-
-    tie %x, "DB_File", "filename" ;
-
-Although it might seem like a real pain, it is really worth the effort
-of having a C<use strict> in all your scripts.
-
-=head1 REFERENCES
-
-Articles that are either about B<DB_File> or make use of it.
-
-=over 5
-
-=item 1.
-
-I<Full-Text Searching in Perl>, Tim Kientzle (tkientzle@ddj.com),
-Dr. Dobb's Journal, Issue 295, January 1999, pp 34-41
-
-=back
-
-=head1 HISTORY
-
-Moved to the Changes file.
-
-=head1 BUGS
-
-Some older versions of Berkeley DB had problems with fixed length
-records using the RECNO file format. This problem has been fixed since
-version 1.85 of Berkeley DB.
-
-I am sure there are bugs in the code. If you do find any, or can
-suggest any enhancements, I would welcome your comments.
-
-=head1 AVAILABILITY
-
-B<DB_File> comes with the standard Perl source distribution. Look in
-the directory F<ext/DB_File>. Given the amount of time between releases
-of Perl the version that ships with Perl is quite likely to be out of
-date, so the most recent version can always be found on CPAN (see
-L<perlmodlib/CPAN> for details), in the directory
-F<modules/by-module/DB_File>.
-
-This version of B<DB_File> will work with either version 1.x, 2.x or
-3.x of Berkeley DB, but is limited to the functionality provided by
-version 1.
-
-The official web site for Berkeley DB is F<http://www.oracle.com/technology/products/berkeley-db/db/index.html>.
-All versions of Berkeley DB are available there.
-
-Alternatively, Berkeley DB version 1 is available at your nearest CPAN
-archive in F<src/misc/db.1.85.tar.gz>.
-
-If you are running IRIX, then get Berkeley DB version 1 from
-F<http://reality.sgi.com/ariel>. It has the patches necessary to
-compile properly on IRIX 5.3.
-
-=head1 COPYRIGHT
-
-Copyright (c) 1995-2007 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<DB_File> 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 are few words taken from the Berkeley DB FAQ (at
-F<http://www.oracle.com/technology/products/berkeley-db/db/index.html>) 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 DB_File. See L<"AUTHOR"> for details.
-
-
-=head1 SEE ALSO
-
-L<perl>, L<dbopen(3)>, L<hash(3)>, L<recno(3)>, L<btree(3)>,
-L<perldbmfilter>
-
-=head1 AUTHOR
-
-The DB_File interface was written by Paul Marquess
-E<lt>pmqs@cpan.orgE<gt>.
-
-=cut
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
deleted file mode 100644
index afd0f63a15..0000000000
--- a/ext/DB_File/DB_File.xs
+++ /dev/null
@@ -1,1995 +0,0 @@
-/* 
-
- DB_File.xs -- Perl 5 interface to Berkeley DB 
-
- written by Paul Marquess <pmqs@cpan.org>
- last modified 4th February 2007
- version 1.818
-
- All comments/suggestions/problems are welcome
-
-     Copyright (c) 1995-2009 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.
-
- Changes:
-	0.1 - 	Initial Release
-	0.2 - 	No longer bombs out if dbopen returns an error.
-	0.3 - 	Added some support for multiple btree compares
-	1.0 - 	Complete support for multiple callbacks added.
-	      	Fixed a problem with pushing a value onto an empty list.
-	1.01 - 	Fixed a SunOS core dump problem.
-		The return value from TIEHASH wasn't set to NULL when
-		dbopen returned an error.
-	1.02 - 	Use ALIAS to define TIEARRAY.
-		Removed some redundant commented code.
-		Merged OS2 code into the main distribution.
-		Allow negative subscripts with RECNO interface.
-		Changed the default flags to O_CREAT|O_RDWR
-	1.03 - 	Added EXISTS
-	1.04 -  fixed a couple of bugs in hash_cb. Patches supplied by
-		Dave Hammen, hammen@gothamcity.jsc.nasa.gov
-	1.05 -  Added logic to allow prefix & hash types to be specified via
-		Makefile.PL
-	1.06 -  Minor namespace cleanup: Localized PrintBtree.
-	1.07 -  Fixed bug with RECNO, where bval wasn't defaulting to "\n". 
-	1.08 -  No change to DB_File.xs
-	1.09 -  Default mode for dbopen changed to 0666
-	1.10 -  Fixed fd method so that it still returns -1 for
-		in-memory files when db 1.86 is used.
-	1.11 -  No change to DB_File.xs
-	1.12 -  No change to DB_File.xs
-	1.13 -  Tidied up a few casts.     
-	1.14 -	Made it illegal to tie an associative array to a RECNO
-		database and an ordinary array to a HASH or BTREE database.
-	1.50 -  Make work with both DB 1.x or DB 2.x
-	1.51 -  Fixed a bug in mapping 1.x O_RDONLY flag to 2.x DB_RDONLY equivalent
-	1.52 -  Patch from Gisle Aas <gisle@aas.no> to suppress "use of 
-		undefined value" warning with db_get and db_seq.
-	1.53 -  Added DB_RENUMBER to flags for recno.
-	1.54 -  Fixed bug in the fd method
-        1.55 -  Fix for AIX from Jarkko Hietaniemi
-        1.56 -  No change to DB_File.xs
-        1.57 -  added the #undef op to allow building with Threads support.
-	1.58 -  Fixed a problem with the use of sv_setpvn. When the
-		size is specified as 0, it does a strlen on the data.
-		This was ok for DB 1.x, but isn't for DB 2.x.
-        1.59 -  No change to DB_File.xs
-        1.60 -  Some code tidy up
-        1.61 -  added flagSet macro for DB 2.5.x
-		fixed typo in O_RDONLY test.
-        1.62 -  No change to DB_File.xs
-        1.63 -  Fix to alllow DB 2.6.x to build.
-        1.64 -  Tidied up the 1.x to 2.x flags mapping code.
-		Added a patch from Mark Kettenis <kettenis@wins.uva.nl>
-		to fix a flag mapping problem with O_RDONLY on the Hurd
-        1.65 -  Fixed a bug in the PUSH logic.
-		Added BOOT check that using 2.3.4 or greater
-        1.66 -  Added DBM filter code
-        1.67 -  Backed off the use of newSVpvn.
-		Fixed DBM Filter code for Perl 5.004.
-		Fixed a small memory leak in the filter code.
-        1.68 -  fixed backward compatability bug with R_IAFTER & R_IBEFORE
-		merged in the 5.005_58 changes
-        1.69 -  fixed a bug in push -- DB_APPEND wasn't working properly.
-		Fixed the R_SETCURSOR bug introduced in 1.68
-		Added a new Perl variable $DB_File::db_ver 
-        1.70 -  Initialise $DB_File::db_ver and $DB_File::db_version with 
-		GV_ADD|GV_ADDMULT -- bug spotted by Nick Ing-Simmons.
-		Added a BOOT check to test for equivalent versions of db.h &
-		libdb.a/so.
-        1.71 -  Support for Berkeley DB version 3.
-		Support for Berkeley DB 2/3's backward compatability mode.
-		Rewrote push
-        1.72 -  No change to DB_File.xs
-        1.73 -  No change to DB_File.xs
-        1.74 -  A call to open needed parenthesised to stop it clashing
-                with a win32 macro.
-		Added Perl core patches 7703 & 7801.
-        1.75 -  Fixed Perl core patch 7703.
-		Added suppport to allow DB_File to be built with 
-		Berkeley DB 3.2 -- btree_compare, btree_prefix and hash_cb
-		needed to be changed.
-        1.76 -  No change to DB_File.xs
-        1.77 -  Tidied up a few types used in calling newSVpvn.
-        1.78 -  Core patch 10335, 10372, 10534, 10549, 11051 included.
-        1.79 -  NEXTKEY ignores the input key.
-                Added lots of casts
-        1.800 - Moved backward compatability code into ppport.h.
-                Use the new constants code.
-        1.801 - No change to DB_File.xs
-        1.802 - No change to DB_File.xs
-        1.803 - FETCH, STORE & DELETE don't map the flags parameter
-                into the equivalent Berkeley DB function anymore.
-        1.804 - no change.
-        1.805 - recursion detection added to the callbacks
-                Support for 4.1.X added.
-                Filter code can now cope with read-only $_
-        1.806 - recursion detection beefed up.
-        1.807 - no change
-        1.808 - leak fixed in ParseOpenInfo
-        1.809 - no change
-        1.810 - no change
-        1.811 - no change
-        1.812 - no change
-        1.813 - no change
-        1.814 - no change
-        1.814 - C++ casting fixes
-
-*/
-
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"  
-#include "perl.h"
-#include "XSUB.h"
-
-#ifdef _NOT_CORE
-#  include "ppport.h"
-#endif
-
-/* Mention DB_VERSION_MAJOR_CFG, DB_VERSION_MINOR_CFG, and
-   DB_VERSION_PATCH_CFG here so that Configure pulls them all in. */
-
-/* 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. */
-
-/* #if DB_VERSION_MAJOR_CFG < 2  */
-#ifndef DB_VERSION_MAJOR
-#    undef __attribute__
-#endif
-
-#ifdef COMPAT185
-#    include <db_185.h>
-#else
-#    include <db.h>
-#endif
-
-/* Wall starts with 5.7.x */
-
-#if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 7)
-
-/* Since we dropped the gccish definition of __attribute__ we will want
- * to redefine dNOOP, however (so that dTHX continues to work).  Yes,
- * all this means that we can't do attribute checking on the DB_File,
- * boo, hiss. */
-#  ifndef DB_VERSION_MAJOR
-
-#    undef  dNOOP
-#    define dNOOP extern int Perl___notused
-
-    /* Ditto for dXSARGS. */
-#    undef  dXSARGS
-#    define dXSARGS				\
-	dSP; dMARK;			\
-	I32 ax = mark - PL_stack_base + 1;	\
-	I32 items = sp - mark
-
-#  endif
-
-/* avoid -Wall; DB_File xsubs never make use of `ix' setup for ALIASes */
-#  undef dXSI32
-#  define dXSI32 dNOOP
-
-#endif /* Perl >= 5.7 */
-
-#include <fcntl.h> 
-
-/* #define TRACE */
-
-#ifdef TRACE
-#    define Trace(x)        printf x
-#else
-#    define Trace(x)
-#endif
-
-
-#define DBT_clear(x)	Zero(&x, 1, DBT) ;
-
-#ifdef DB_VERSION_MAJOR
-
-#if DB_VERSION_MAJOR == 2
-#    define BERKELEY_DB_1_OR_2
-#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 >= 3)
-#    define AT_LEAST_DB_3_3
-#endif
-
-#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
-#    define AT_LEAST_DB_4_1
-#endif
-
-#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 3)
-#    define AT_LEAST_DB_4_3
-#endif
-
-#ifdef AT_LEAST_DB_3_3
-#   define WANT_ERROR
-#endif
-
-/* map version 2 features & constants onto their version 1 equivalent */
-
-#ifdef DB_Prefix_t
-#    undef DB_Prefix_t
-#endif
-#define DB_Prefix_t	size_t
-
-#ifdef DB_Hash_t
-#    undef DB_Hash_t
-#endif
-#define DB_Hash_t	u_int32_t
-
-/* DBTYPE stays the same */
-/* HASHINFO, RECNOINFO and BTREEINFO  map to DB_INFO */
-#if DB_VERSION_MAJOR == 2
-    typedef DB_INFO	INFO ;
-#else /* DB_VERSION_MAJOR > 2 */
-#    define DB_FIXEDLEN	(0x8000)
-#endif /* DB_VERSION_MAJOR == 2 */
-
-/* version 2 has db_recno_t in place of recno_t	*/
-typedef db_recno_t	recno_t;
-
-
-#define R_CURSOR        DB_SET_RANGE
-#define R_FIRST         DB_FIRST
-#define R_IAFTER        DB_AFTER
-#define R_IBEFORE       DB_BEFORE
-#define R_LAST          DB_LAST
-#define R_NEXT          DB_NEXT
-#define R_NOOVERWRITE   DB_NOOVERWRITE
-#define R_PREV          DB_PREV
-
-#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
-#  define R_SETCURSOR	0x800000
-#else
-#  define R_SETCURSOR	(-100)
-#endif
-
-#define R_RECNOSYNC     0
-#define R_FIXEDLEN	DB_FIXEDLEN
-#define R_DUP		DB_DUP
-
-
-#define db_HA_hash 	h_hash
-#define db_HA_ffactor	h_ffactor
-#define db_HA_nelem	h_nelem
-#define db_HA_bsize	db_pagesize
-#define db_HA_cachesize	db_cachesize
-#define db_HA_lorder	db_lorder
-
-#define db_BT_compare	bt_compare
-#define db_BT_prefix	bt_prefix
-#define db_BT_flags	flags
-#define db_BT_psize	db_pagesize
-#define db_BT_cachesize	db_cachesize
-#define db_BT_lorder	db_lorder
-#define db_BT_maxkeypage
-#define db_BT_minkeypage
-
-
-#define db_RE_reclen	re_len
-#define db_RE_flags	flags
-#define db_RE_bval	re_pad
-#define db_RE_bfname	re_source
-#define db_RE_psize	db_pagesize
-#define db_RE_cachesize	db_cachesize
-#define db_RE_lorder	db_lorder
-
-#define TXN	NULL,
-
-#define do_SEQ(db, key, value, flag)	(db->cursor->c_get)(db->cursor, &key, &value, flag)
-
-
-#define DBT_flags(x)	x.flags = 0
-#define DB_flags(x, v)	x |= v 
-
-#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 5
-#    define flagSet(flags, bitmask)	((flags) & (bitmask))
-#else
-#    define flagSet(flags, bitmask)	(((flags) & DB_OPFLAGS_MASK) == (bitmask))
-#endif
-
-#else /* db version 1.x */
-
-#define BERKELEY_DB_1
-#define BERKELEY_DB_1_OR_2
-
-typedef union INFO {
-        HASHINFO 	hash ;
-        RECNOINFO 	recno ;
-        BTREEINFO 	btree ;
-      } INFO ;
-
-
-#ifdef mDB_Prefix_t 
-#  ifdef DB_Prefix_t
-#    undef DB_Prefix_t
-#  endif
-#  define DB_Prefix_t	mDB_Prefix_t 
-#endif
-
-#ifdef mDB_Hash_t
-#  ifdef DB_Hash_t
-#    undef DB_Hash_t
-#  endif
-#  define DB_Hash_t	mDB_Hash_t
-#endif
-
-#define db_HA_hash 	hash.hash
-#define db_HA_ffactor	hash.ffactor
-#define db_HA_nelem	hash.nelem
-#define db_HA_bsize	hash.bsize
-#define db_HA_cachesize	hash.cachesize
-#define db_HA_lorder	hash.lorder
-
-#define db_BT_compare	btree.compare
-#define db_BT_prefix	btree.prefix
-#define db_BT_flags	btree.flags
-#define db_BT_psize	btree.psize
-#define db_BT_cachesize	btree.cachesize
-#define db_BT_lorder	btree.lorder
-#define db_BT_maxkeypage btree.maxkeypage
-#define db_BT_minkeypage btree.minkeypage
-
-#define db_RE_reclen	recno.reclen
-#define db_RE_flags	recno.flags
-#define db_RE_bval	recno.bval
-#define db_RE_bfname	recno.bfname
-#define db_RE_psize	recno.psize
-#define db_RE_cachesize	recno.cachesize
-#define db_RE_lorder	recno.lorder
-
-#define TXN	
-
-#define do_SEQ(db, key, value, flag)	(db->dbp->seq)(db->dbp, &key, &value, flag)
-#define DBT_flags(x)	
-#define DB_flags(x, v)	
-#define flagSet(flags, bitmask)        ((flags) & (bitmask))
-
-#endif /* db version 1 */
-
-
-
-#define db_DELETE(db, key, flags)       ((db->dbp)->del)(db->dbp, TXN &key, 0)
-#define db_STORE(db, key, value, flags) ((db->dbp)->put)(db->dbp, TXN &key, &value, 0)
-#define db_FETCH(db, key, flags)        ((db->dbp)->get)(db->dbp, TXN &key, &value, 0)
-
-#define db_sync(db, flags)              ((db->dbp)->sync)(db->dbp, flags)
-#define db_get(db, key, value, flags)   ((db->dbp)->get)(db->dbp, TXN &key, &value, flags)
-
-#ifdef DB_VERSION_MAJOR
-#define db_DESTROY(db)                  (!db->aborted && ( db->cursor->c_close(db->cursor),\
-					  (db->dbp->close)(db->dbp, 0) ))
-#define db_close(db)			((db->dbp)->close)(db->dbp, 0)
-#define db_del(db, key, flags)          (flagSet(flags, R_CURSOR) 					\
-						? ((db->cursor)->c_del)(db->cursor, 0)		\
-						: ((db->dbp)->del)(db->dbp, NULL, &key, flags) )
-
-#else /* ! DB_VERSION_MAJOR */
-
-#define db_DESTROY(db)                  (!db->aborted && ((db->dbp)->close)(db->dbp))
-#define db_close(db)			((db->dbp)->close)(db->dbp)
-#define db_del(db, key, flags)          ((db->dbp)->del)(db->dbp, &key, flags)
-#define db_put(db, key, value, flags)   ((db->dbp)->put)(db->dbp, &key, &value, flags)
-
-#endif /* ! DB_VERSION_MAJOR */
-
-
-#define db_seq(db, key, value, flags)   do_SEQ(db, key, value, flags)
-
-typedef struct {
-	DBTYPE	type ;
-	DB * 	dbp ;
-	SV *	compare ;
-	bool	in_compare ;
-	SV *	prefix ;
-	bool	in_prefix ;
-	SV *	hash ;
-	bool	in_hash ;
-	bool	aborted ;
-	int	in_memory ;
-#ifdef BERKELEY_DB_1_OR_2
-	INFO 	info ;
-#endif	
-#ifdef DB_VERSION_MAJOR
-	DBC *	cursor ;
-#endif
-	SV *    filter_fetch_key ;
-	SV *    filter_store_key ;
-	SV *    filter_fetch_value ;
-	SV *    filter_store_value ;
-	int     filtering ;
-
-	} DB_File_type;
-
-typedef DB_File_type * DB_File ;
-typedef DBT DBTKEY ;
-
-#define my_sv_setpvn(sv, d, s) sv_setpvn(sv, (s ? d : (const char *)""), s)
-
-#define OutputValue(arg, name)  					\
-	{ if (RETVAL == 0) {						\
-	      SvGETMAGIC(arg) ;          				\
-	      my_sv_setpvn(arg, (const char *)name.data, name.size) ;			\
-	      TAINT;                                       		\
-	      SvTAINTED_on(arg);                                       	\
-	      SvUTF8_off(arg);                                       	\
-	      DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; 	\
-	  }								\
-	}
-
-#define OutputKey(arg, name)	 					\
-	{ if (RETVAL == 0) 						\
-	  { 								\
-		SvGETMAGIC(arg) ;          				\
-		if (db->type != DB_RECNO) {				\
-		    my_sv_setpvn(arg, (const char *)name.data, name.size); 		\
-		}							\
-		else 							\
-		    sv_setiv(arg, (I32)*(I32*)name.data - 1); 		\
-	      TAINT;                                       		\
-	      SvTAINTED_on(arg);                                       	\
-	      SvUTF8_off(arg);                                       	\
-	      DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; 	\
-	  } 								\
-	}
-
-#define my_SvUV32(sv) ((u_int32_t)SvUV(sv))
-
-#ifdef CAN_PROTOTYPE
-extern void __getBerkeleyDBInfo(void);
-#endif
-
-/* Internal Global Data */
-
-#define MY_CXT_KEY "DB_File::_guts" XS_VERSION
-
-typedef struct {
-    recno_t	x_Value; 
-    recno_t	x_zero;
-    DB_File	x_CurrentDB;
-    DBTKEY	x_empty;
-} my_cxt_t;
-
-START_MY_CXT
-
-#define Value		(MY_CXT.x_Value)
-#define zero		(MY_CXT.x_zero)
-#define CurrentDB	(MY_CXT.x_CurrentDB)
-#define empty		(MY_CXT.x_empty)
-
-#define ERR_BUFF "DB_File::Error"
-
-#ifdef DB_VERSION_MAJOR
-
-static int
-#ifdef CAN_PROTOTYPE
-db_put(DB_File db, DBTKEY key, DBT value, u_int flags)
-#else
-db_put(db, key, value, flags)
-DB_File		db ;
-DBTKEY		key ;
-DBT		value ;
-u_int		flags ;
-#endif
-{
-    int status ;
-
-    if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) {
-        DBC * temp_cursor ;
-	DBT l_key, l_value;
-        
-#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
-        if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor) != 0)
-#else
-        if (((db->dbp)->cursor)(db->dbp, NULL, &temp_cursor, 0) != 0)
-#endif
-	    return (-1) ;
-
-	memset(&l_key, 0, sizeof(l_key));
-	l_key.data = key.data;
-	l_key.size = key.size;
-	memset(&l_value, 0, sizeof(l_value));
-	l_value.data = value.data;
-	l_value.size = value.size;
-
-	if ( temp_cursor->c_get(temp_cursor, &l_key, &l_value, DB_SET) != 0) {
-	    (void)temp_cursor->c_close(temp_cursor);
-	    return (-1);
-	}
-
-	status = temp_cursor->c_put(temp_cursor, &key, &value, flags);
-	(void)temp_cursor->c_close(temp_cursor);
-	    
-        return (status) ;
-    }	
-    
-    
-    if (flagSet(flags, R_CURSOR)) {
-	return ((db->cursor)->c_put)(db->cursor, &key, &value, DB_CURRENT);
-    }
-
-    if (flagSet(flags, R_SETCURSOR)) {
-	if ((db->dbp)->put(db->dbp, NULL, &key, &value, 0) != 0)
-		return -1 ;
-        return ((db->cursor)->c_get)(db->cursor, &key, &value, DB_SET_RANGE);
-    
-    }
-
-    return ((db->dbp)->put)(db->dbp, NULL, &key, &value, flags) ;
-
-}
-
-#endif /* DB_VERSION_MAJOR */
-
-static void
-tidyUp(DB_File db)
-{
-    db->aborted = TRUE ;
-}
-
-
-static int
-#ifdef AT_LEAST_DB_3_2
-
-#ifdef CAN_PROTOTYPE
-btree_compare(DB * db, const DBT *key1, const DBT *key2)
-#else
-btree_compare(db, key1, key2)
-DB * db ;
-const DBT * key1 ;
-const DBT * key2 ;
-#endif /* CAN_PROTOTYPE */
-
-#else /* Berkeley DB < 3.2 */
-
-#ifdef CAN_PROTOTYPE
-btree_compare(const DBT *key1, const DBT *key2)
-#else
-btree_compare(key1, key2)
-const DBT * key1 ;
-const DBT * key2 ;
-#endif
-
-#endif
-
-{
-#ifdef dTHX
-    dTHX;
-#endif    
-    dSP ;
-    dMY_CXT ;
-    void * data1, * data2 ;
-    int retval ;
-    int count ;
-    
-
-    if (CurrentDB->in_compare) {
-        tidyUp(CurrentDB);
-        croak ("DB_File btree_compare: recursion detected\n") ;
-    }
-
-    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;
-    SAVESPTR(CurrentDB);
-    CurrentDB->in_compare = FALSE;
-    SAVEINT(CurrentDB->in_compare);
-    CurrentDB->in_compare = TRUE;
-
-    PUSHMARK(SP) ;
-    EXTEND(SP,2) ;
-    PUSHs(sv_2mortal(newSVpvn((const char*)data1,key1->size)));
-    PUSHs(sv_2mortal(newSVpvn((const char*)data2,key2->size)));
-    PUTBACK ;
-
-    count = perl_call_sv(CurrentDB->compare, G_SCALAR); 
-
-    SPAGAIN ;
-
-    if (count != 1){
-        tidyUp(CurrentDB);
-        croak ("DB_File btree_compare: expected 1 return value from compare sub, got %d\n", count) ;
-    }
-
-    retval = POPi ;
-
-    PUTBACK ;
-    FREETMPS ;
-    LEAVE ;
-
-    return (retval) ;
-
-}
-
-static DB_Prefix_t
-#ifdef AT_LEAST_DB_3_2
-
-#ifdef CAN_PROTOTYPE
-btree_prefix(DB * db, const DBT *key1, const DBT *key2)
-#else
-btree_prefix(db, key1, key2)
-Db * db ;
-const DBT * key1 ;
-const DBT * key2 ;
-#endif
-
-#else /* Berkeley DB < 3.2 */
-
-#ifdef CAN_PROTOTYPE
-btree_prefix(const DBT *key1, const DBT *key2)
-#else
-btree_prefix(key1, key2)
-const DBT * key1 ;
-const DBT * key2 ;
-#endif
-
-#endif
-{
-#ifdef dTHX
-    dTHX;
-#endif    
-    dSP ;
-    dMY_CXT ;
-    char * data1, * data2 ;
-    int retval ;
-    int count ;
-    
-    if (CurrentDB->in_prefix){
-        tidyUp(CurrentDB);
-        croak ("DB_File btree_prefix: recursion detected\n") ;
-    }
-
-    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;
-    SAVESPTR(CurrentDB);
-    CurrentDB->in_prefix = FALSE;
-    SAVEINT(CurrentDB->in_prefix);
-    CurrentDB->in_prefix = TRUE;
-
-    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){
-        tidyUp(CurrentDB);
-        croak ("DB_File btree_prefix: expected 1 return value from prefix sub, got %d\n", count) ;
-    }
- 
-    retval = POPi ;
- 
-    PUTBACK ;
-    FREETMPS ;
-    LEAVE ;
-
-    return (retval) ;
-}
-
-
-#ifdef BERKELEY_DB_1
-#    define HASH_CB_SIZE_TYPE size_t
-#else
-#    define HASH_CB_SIZE_TYPE u_int32_t
-#endif
-
-static DB_Hash_t
-#ifdef AT_LEAST_DB_3_2
-
-#ifdef CAN_PROTOTYPE
-hash_cb(DB * db, const void *data, u_int32_t size)
-#else
-hash_cb(db, data, size)
-DB * db ;
-const void * data ;
-HASH_CB_SIZE_TYPE size ;
-#endif
-
-#else /* Berkeley DB < 3.2 */
-
-#ifdef CAN_PROTOTYPE
-hash_cb(const void *data, HASH_CB_SIZE_TYPE size)
-#else
-hash_cb(data, size)
-const void * data ;
-HASH_CB_SIZE_TYPE size ;
-#endif
-
-#endif
-{
-#ifdef dTHX
-    dTHX;
-#endif    
-    dSP ;
-    dMY_CXT;
-    int retval = 0;
-    int count ;
-
-    if (CurrentDB->in_hash){
-        tidyUp(CurrentDB);
-        croak ("DB_File hash callback: recursion detected\n") ;
-    }
-
-#ifndef newSVpvn
-    if (size == 0)
-        data = "" ;
-#endif	
-
-     /* DGH - Next two lines added to fix corrupted stack problem */
-    ENTER ;
-    SAVETMPS;
-    SAVESPTR(CurrentDB);
-    CurrentDB->in_hash = FALSE;
-    SAVEINT(CurrentDB->in_hash);
-    CurrentDB->in_hash = TRUE;
-
-    PUSHMARK(SP) ;
-
-
-    XPUSHs(sv_2mortal(newSVpvn((char*)data,size)));
-    PUTBACK ;
-
-    count = perl_call_sv(CurrentDB->hash, G_SCALAR); 
-
-    SPAGAIN ;
-
-    if (count != 1){
-        tidyUp(CurrentDB);
-        croak ("DB_File hash_cb: expected 1 return value from hash sub, got %d\n", count) ;
-    }
-
-    retval = POPi ;
-
-    PUTBACK ;
-    FREETMPS ;
-    LEAVE ;
-
-    return (retval) ;
-}
-
-#ifdef WANT_ERROR
-
-static void
-#ifdef AT_LEAST_DB_4_3
-db_errcall_cb(const DB_ENV* dbenv, const char * db_errpfx, const char * buffer)
-#else
-db_errcall_cb(const char * db_errpfx, char * buffer)
-#endif
-{
-#ifdef dTHX
-    dTHX;
-#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) ;
-    }
-} 
-#endif
-
-#if defined(TRACE) && defined(BERKELEY_DB_1_OR_2)
-
-static void
-#ifdef CAN_PROTOTYPE
-PrintHash(INFO *hash)
-#else
-PrintHash(hash)
-INFO * hash ;
-#endif
-{
-    printf ("HASH Info\n") ;
-    printf ("  hash      = %s\n", 
-		(hash->db_HA_hash != NULL ? "redefined" : "default")) ;
-    printf ("  bsize     = %d\n", hash->db_HA_bsize) ;
-    printf ("  ffactor   = %d\n", hash->db_HA_ffactor) ;
-    printf ("  nelem     = %d\n", hash->db_HA_nelem) ;
-    printf ("  cachesize = %d\n", hash->db_HA_cachesize) ;
-    printf ("  lorder    = %d\n", hash->db_HA_lorder) ;
-
-}
-
-static void
-#ifdef CAN_PROTOTYPE
-PrintRecno(INFO *recno)
-#else
-PrintRecno(recno)
-INFO * recno ;
-#endif
-{
-    printf ("RECNO Info\n") ;
-    printf ("  flags     = %d\n", recno->db_RE_flags) ;
-    printf ("  cachesize = %d\n", recno->db_RE_cachesize) ;
-    printf ("  psize     = %d\n", recno->db_RE_psize) ;
-    printf ("  lorder    = %d\n", recno->db_RE_lorder) ;
-    printf ("  reclen    = %lu\n", (unsigned long)recno->db_RE_reclen) ;
-    printf ("  bval      = %d 0x%x\n", recno->db_RE_bval, recno->db_RE_bval) ;
-    printf ("  bfname    = %d [%s]\n", recno->db_RE_bfname, recno->db_RE_bfname) ;
-}
-
-static void
-#ifdef CAN_PROTOTYPE
-PrintBtree(INFO *btree)
-#else
-PrintBtree(btree)
-INFO * btree ;
-#endif
-{
-    printf ("BTREE Info\n") ;
-    printf ("  compare    = %s\n", 
-		(btree->db_BT_compare ? "redefined" : "default")) ;
-    printf ("  prefix     = %s\n", 
-		(btree->db_BT_prefix ? "redefined" : "default")) ;
-    printf ("  flags      = %d\n", btree->db_BT_flags) ;
-    printf ("  cachesize  = %d\n", btree->db_BT_cachesize) ;
-    printf ("  psize      = %d\n", btree->db_BT_psize) ;
-#ifndef DB_VERSION_MAJOR
-    printf ("  maxkeypage = %d\n", btree->db_BT_maxkeypage) ;
-    printf ("  minkeypage = %d\n", btree->db_BT_minkeypage) ;
-#endif
-    printf ("  lorder     = %d\n", btree->db_BT_lorder) ;
-}
-
-#else
-
-#define PrintRecno(recno)
-#define PrintHash(hash)
-#define PrintBtree(btree)
-
-#endif /* TRACE */
-
-
-static I32
-#ifdef CAN_PROTOTYPE
-GetArrayLength(pTHX_ DB_File db)
-#else
-GetArrayLength(db)
-DB_File db ;
-#endif
-{
-    DBT		key ;
-    DBT		value ;
-    int		RETVAL ;
-
-    DBT_clear(key) ;
-    DBT_clear(value) ;
-    RETVAL = do_SEQ(db, key, value, R_LAST) ;
-    if (RETVAL == 0)
-        RETVAL = *(I32 *)key.data ;
-    else /* No key means empty file */
-        RETVAL = 0 ;
-
-    return ((I32)RETVAL) ;
-}
-
-static recno_t
-#ifdef CAN_PROTOTYPE
-GetRecnoKey(pTHX_ DB_File db, I32 value)
-#else
-GetRecnoKey(db, value)
-DB_File  db ;
-I32      value ;
-#endif
-{
-    if (value < 0) {
-	/* Get the length of the array */
-	I32 length = GetArrayLength(aTHX_ db) ;
-
-	/* check for attempt to write before start of array */
-	if (length + value + 1 <= 0) {
-            tidyUp(db);
-	    croak("Modification of non-creatable array value attempted, subscript %ld", (long)value) ;
-	}
-
-	value = length + value + 1 ;
-    }
-    else
-        ++ value ;
-
-    return value ;
-}
-
-
-static DB_File
-#ifdef CAN_PROTOTYPE
-ParseOpenInfo(pTHX_ int isHASH, char *name, int flags, int mode, SV *sv)
-#else
-ParseOpenInfo(isHASH, name, flags, mode, sv)
-int    isHASH ;
-char * name ;
-int    flags ;
-int    mode ;
-SV *   sv ;
-#endif
-{
-
-#ifdef BERKELEY_DB_1_OR_2 /* Berkeley DB Version 1  or 2 */
-
-    SV **	svp;
-    HV *	action ;
-    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
-    void *	openinfo = NULL ;
-    INFO	* info  = &RETVAL->info ;
-    STRLEN	n_a;
-    dMY_CXT;
-
-#ifdef TRACE    
-    printf("In ParseOpenInfo name=[%s] flags=[%d] mode=[%d] SV NULL=[%d]\n", 
-		    name, flags, mode, sv == NULL) ;  
-#endif
-    Zero(RETVAL, 1, DB_File_type) ;
-
-    /* Default to HASH */
-    RETVAL->filtering = 0 ;
-    RETVAL->filter_fetch_key = RETVAL->filter_store_key = 
-    RETVAL->filter_fetch_value = RETVAL->filter_store_value =
-    RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
-    RETVAL->type = DB_HASH ;
-
-     /* DGH - Next line added to avoid SEGV on existing hash DB */
-    CurrentDB = RETVAL; 
-
-    /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
-    RETVAL->in_memory = (name == NULL) ;
-
-    if (sv)
-    {
-        if (! SvROK(sv) )
-            croak ("type parameter is not a reference") ;
-
-        svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
-        if (svp && SvOK(*svp))
-            action  = (HV*) SvRV(*svp) ;
-	else
-	    croak("internal error") ;
-
-        if (sv_isa(sv, "DB_File::HASHINFO"))
-        {
-
-	    if (!isHASH)
-	        croak("DB_File can only tie an associative array to a DB_HASH database") ;
-
-            RETVAL->type = DB_HASH ;
-            openinfo = (void*)info ;
-  
-            svp = hv_fetch(action, "hash", 4, FALSE); 
-
-            if (svp && SvOK(*svp))
-            {
-                info->db_HA_hash = hash_cb ;
-		RETVAL->hash = newSVsv(*svp) ;
-            }
-            else
-	        info->db_HA_hash = NULL ;
-
-           svp = hv_fetch(action, "ffactor", 7, FALSE);
-           info->db_HA_ffactor = svp ? SvIV(*svp) : 0;
-         
-           svp = hv_fetch(action, "nelem", 5, FALSE);
-           info->db_HA_nelem = svp ? SvIV(*svp) : 0;
-         
-           svp = hv_fetch(action, "bsize", 5, FALSE);
-           info->db_HA_bsize = svp ? SvIV(*svp) : 0;
-           
-           svp = hv_fetch(action, "cachesize", 9, FALSE);
-           info->db_HA_cachesize = svp ? SvIV(*svp) : 0;
-         
-           svp = hv_fetch(action, "lorder", 6, FALSE);
-           info->db_HA_lorder = svp ? SvIV(*svp) : 0;
-
-           PrintHash(info) ; 
-        }
-        else if (sv_isa(sv, "DB_File::BTREEINFO"))
-        {
-	    if (!isHASH)
-	        croak("DB_File can only tie an associative array to a DB_BTREE database");
-
-            RETVAL->type = DB_BTREE ;
-            openinfo = (void*)info ;
-   
-            svp = hv_fetch(action, "compare", 7, FALSE);
-            if (svp && SvOK(*svp))
-            {
-                info->db_BT_compare = btree_compare ;
-		RETVAL->compare = newSVsv(*svp) ;
-            }
-            else
-                info->db_BT_compare = NULL ;
-
-            svp = hv_fetch(action, "prefix", 6, FALSE);
-            if (svp && SvOK(*svp))
-            {
-                info->db_BT_prefix = btree_prefix ;
-		RETVAL->prefix = newSVsv(*svp) ;
-            }
-            else
-                info->db_BT_prefix = NULL ;
-
-            svp = hv_fetch(action, "flags", 5, FALSE);
-            info->db_BT_flags = svp ? SvIV(*svp) : 0;
-   
-            svp = hv_fetch(action, "cachesize", 9, FALSE);
-            info->db_BT_cachesize = svp ? SvIV(*svp) : 0;
-         
-#ifndef DB_VERSION_MAJOR
-            svp = hv_fetch(action, "minkeypage", 10, FALSE);
-            info->btree.minkeypage = svp ? SvIV(*svp) : 0;
-        
-            svp = hv_fetch(action, "maxkeypage", 10, FALSE);
-            info->btree.maxkeypage = svp ? SvIV(*svp) : 0;
-#endif
-
-            svp = hv_fetch(action, "psize", 5, FALSE);
-            info->db_BT_psize = svp ? SvIV(*svp) : 0;
-         
-            svp = hv_fetch(action, "lorder", 6, FALSE);
-            info->db_BT_lorder = svp ? SvIV(*svp) : 0;
-
-            PrintBtree(info) ;
-         
-        }
-        else if (sv_isa(sv, "DB_File::RECNOINFO"))
-        {
-	    if (isHASH)
-	        croak("DB_File can only tie an array to a DB_RECNO database");
-
-            RETVAL->type = DB_RECNO ;
-            openinfo = (void *)info ;
-
-	    info->db_RE_flags = 0 ;
-
-            svp = hv_fetch(action, "flags", 5, FALSE);
-            info->db_RE_flags = (u_long) (svp ? SvIV(*svp) : 0);
-         
-            svp = hv_fetch(action, "reclen", 6, FALSE);
-            info->db_RE_reclen = (size_t) (svp ? SvIV(*svp) : 0);
-         
-            svp = hv_fetch(action, "cachesize", 9, FALSE);
-            info->db_RE_cachesize = (u_int) (svp ? SvIV(*svp) : 0);
-         
-            svp = hv_fetch(action, "psize", 5, FALSE);
-            info->db_RE_psize = (u_int) (svp ? SvIV(*svp) : 0);
-         
-            svp = hv_fetch(action, "lorder", 6, FALSE);
-            info->db_RE_lorder = (int) (svp ? SvIV(*svp) : 0);
-
-#ifdef DB_VERSION_MAJOR
-	    info->re_source = name ;
-	    name = NULL ;
-#endif
-            svp = hv_fetch(action, "bfname", 6, FALSE); 
-            if (svp && SvOK(*svp)) {
-		char * ptr = SvPV(*svp,n_a) ;
-#ifdef DB_VERSION_MAJOR
-		name = (char*) n_a ? ptr : NULL ;
-#else
-                info->db_RE_bfname = (char*) (n_a ? ptr : NULL) ;
-#endif
-	    }
-	    else
-#ifdef DB_VERSION_MAJOR
-		name = NULL ;
-#else
-                info->db_RE_bfname = NULL ;
-#endif
-         
-	    svp = hv_fetch(action, "bval", 4, FALSE);
-#ifdef DB_VERSION_MAJOR
-            if (svp && SvOK(*svp))
-            {
-		int value ;
-                if (SvPOK(*svp))
-		    value = (int)*SvPV(*svp, n_a) ;
-		else
-		    value = SvIV(*svp) ;
-
-		if (info->flags & DB_FIXEDLEN) {
-		    info->re_pad = value ;
-		    info->flags |= DB_PAD ;
-		}
-		else {
-		    info->re_delim = value ;
-		    info->flags |= DB_DELIMITER ;
-		}
-
-            }
-#else
-            if (svp && SvOK(*svp))
-            {
-                if (SvPOK(*svp))
-		    info->db_RE_bval = (u_char)*SvPV(*svp, n_a) ;
-		else
-		    info->db_RE_bval = (u_char)(unsigned long) SvIV(*svp) ;
-		DB_flags(info->flags, DB_DELIMITER) ;
-
-            }
-            else
- 	    {
-		if (info->db_RE_flags & R_FIXEDLEN)
-                    info->db_RE_bval = (u_char) ' ' ;
-		else
-                    info->db_RE_bval = (u_char) '\n' ;
-		DB_flags(info->flags, DB_DELIMITER) ;
-	    }
-#endif
-
-#ifdef DB_RENUMBER
-	    info->flags |= DB_RENUMBER ;
-#endif
-         
-            PrintRecno(info) ;
-        }
-        else
-            croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
-    }
-
-
-    /* OS2 Specific Code */
-#ifdef OS2
-#ifdef __EMX__
-    flags |= O_BINARY;
-#endif /* __EMX__ */
-#endif /* OS2 */
-
-#ifdef DB_VERSION_MAJOR
-
-    {
-        int	 	Flags = 0 ;
-        int		status ;
-
-        /* Map 1.x flags to 2.x flags */
-        if ((flags & O_CREAT) == O_CREAT)
-            Flags |= DB_CREATE ;
-
-#if O_RDONLY == 0
-        if (flags == O_RDONLY)
-#else
-        if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
-#endif
-            Flags |= DB_RDONLY ;
-
-#ifdef O_TRUNC
-        if ((flags & O_TRUNC) == O_TRUNC)
-            Flags |= DB_TRUNCATE ;
-#endif
-
-        status = db_open(name, RETVAL->type, Flags, mode, NULL, (DB_INFO*)openinfo, &RETVAL->dbp) ; 
-        if (status == 0)
-#if DB_VERSION_MAJOR == 2 && DB_VERSION_MINOR < 6
-            status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor) ;
-#else
-            status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
-			0) ;
-#endif
-
-        if (status)
-	    RETVAL->dbp = NULL ;
-
-    }
-#else
-
-#if defined(DB_LIBRARY_COMPATIBILITY_API) && DB_VERSION_MAJOR > 2
-    RETVAL->dbp = __db185_open(name, flags, mode, RETVAL->type, openinfo) ; 
-#else    
-    RETVAL->dbp = dbopen(name, flags, mode, RETVAL->type, openinfo) ; 
-#endif /* DB_LIBRARY_COMPATIBILITY_API */
-
-#endif
-
-    return (RETVAL) ;
-
-#else /* Berkeley DB Version > 2 */
-
-    SV **	svp;
-    HV *	action ;
-    DB_File	RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
-    DB *	dbp ;
-    STRLEN	n_a;
-    int		status ;
-    dMY_CXT;
-
-/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ;  */
-    Zero(RETVAL, 1, DB_File_type) ;
-
-    /* Default to HASH */
-    RETVAL->filtering = 0 ;
-    RETVAL->filter_fetch_key = RETVAL->filter_store_key = 
-    RETVAL->filter_fetch_value = RETVAL->filter_store_value =
-    RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
-    RETVAL->type = DB_HASH ;
-
-     /* DGH - Next line added to avoid SEGV on existing hash DB */
-    CurrentDB = RETVAL; 
-
-    /* fd for 1.86 hash in memory files doesn't return -1 like 1.85 */
-    RETVAL->in_memory = (name == NULL) ;
-
-    status = db_create(&RETVAL->dbp, NULL,0) ;
-    /* printf("db_create returned %d %s\n", status, db_strerror(status)) ; */
-    if (status) {
-	RETVAL->dbp = NULL ;
-        return (RETVAL) ;
-    }	
-    dbp = RETVAL->dbp ;
-
-#ifdef WANT_ERROR
-	    RETVAL->dbp->set_errcall(RETVAL->dbp, db_errcall_cb) ;
-#endif
-    if (sv)
-    {
-        if (! SvROK(sv) )
-            croak ("type parameter is not a reference") ;
-
-        svp  = hv_fetch( (HV*)SvRV(sv), "GOT", 3, FALSE) ;
-        if (svp && SvOK(*svp))
-            action  = (HV*) SvRV(*svp) ;
-	else
-	    croak("internal error") ;
-
-        if (sv_isa(sv, "DB_File::HASHINFO"))
-        {
-
-	    if (!isHASH)
-	        croak("DB_File can only tie an associative array to a DB_HASH database") ;
-
-            RETVAL->type = DB_HASH ;
-  
-            svp = hv_fetch(action, "hash", 4, FALSE); 
-
-            if (svp && SvOK(*svp))
-            {
-		(void)dbp->set_h_hash(dbp, hash_cb) ;
-		RETVAL->hash = newSVsv(*svp) ;
-            }
-
-           svp = hv_fetch(action, "ffactor", 7, FALSE);
-	   if (svp)
-	       (void)dbp->set_h_ffactor(dbp, my_SvUV32(*svp)) ;
-         
-           svp = hv_fetch(action, "nelem", 5, FALSE);
-	   if (svp)
-               (void)dbp->set_h_nelem(dbp, my_SvUV32(*svp)) ;
-         
-           svp = hv_fetch(action, "bsize", 5, FALSE);
-	   if (svp)
-               (void)dbp->set_pagesize(dbp, my_SvUV32(*svp));
-           
-           svp = hv_fetch(action, "cachesize", 9, FALSE);
-	   if (svp)
-               (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
-         
-           svp = hv_fetch(action, "lorder", 6, FALSE);
-	   if (svp)
-               (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
-
-           PrintHash(info) ; 
-        }
-        else if (sv_isa(sv, "DB_File::BTREEINFO"))
-        {
-	    if (!isHASH)
-	        croak("DB_File can only tie an associative array to a DB_BTREE database");
-
-            RETVAL->type = DB_BTREE ;
-   
-            svp = hv_fetch(action, "compare", 7, FALSE);
-            if (svp && SvOK(*svp))
-            {
-                (void)dbp->set_bt_compare(dbp, btree_compare) ;
-		RETVAL->compare = newSVsv(*svp) ;
-            }
-
-            svp = hv_fetch(action, "prefix", 6, FALSE);
-            if (svp && SvOK(*svp))
-            {
-                (void)dbp->set_bt_prefix(dbp, btree_prefix) ;
-		RETVAL->prefix = newSVsv(*svp) ;
-            }
-
-           svp = hv_fetch(action, "flags", 5, FALSE);
-	   if (svp)
-	       (void)dbp->set_flags(dbp, my_SvUV32(*svp)) ;
-   
-           svp = hv_fetch(action, "cachesize", 9, FALSE);
-	   if (svp)
-               (void)dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
-         
-           svp = hv_fetch(action, "psize", 5, FALSE);
-	   if (svp)
-               (void)dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
-         
-           svp = hv_fetch(action, "lorder", 6, FALSE);
-	   if (svp)
-               (void)dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
-
-            PrintBtree(info) ;
-         
-        }
-        else if (sv_isa(sv, "DB_File::RECNOINFO"))
-        {
-	    int fixed = FALSE ;
-
-	    if (isHASH)
-	        croak("DB_File can only tie an array to a DB_RECNO database");
-
-            RETVAL->type = DB_RECNO ;
-
-           svp = hv_fetch(action, "flags", 5, FALSE);
-	   if (svp) {
-		int flags = SvIV(*svp) ;
-		/* remove FIXDLEN, if present */
-		if (flags & DB_FIXEDLEN) {
-		    fixed = TRUE ;
-		    flags &= ~DB_FIXEDLEN ;
-	   	}
-	   }
-
-           svp = hv_fetch(action, "cachesize", 9, FALSE);
-	   if (svp) {
-               status = dbp->set_cachesize(dbp, 0, my_SvUV32(*svp), 0) ;
-	   }
-         
-           svp = hv_fetch(action, "psize", 5, FALSE);
-	   if (svp) {
-               status = dbp->set_pagesize(dbp, my_SvUV32(*svp)) ;
-	    }
-         
-           svp = hv_fetch(action, "lorder", 6, FALSE);
-	   if (svp) {
-               status = dbp->set_lorder(dbp, (int)SvIV(*svp)) ;
-	   }
-
-	    svp = hv_fetch(action, "bval", 4, FALSE);
-            if (svp && SvOK(*svp))
-            {
-		int value ;
-                if (SvPOK(*svp))
-		    value = (int)*SvPV(*svp, n_a) ;
-		else
-		    value = (int)SvIV(*svp) ;
-
-		if (fixed) {
-		    status = dbp->set_re_pad(dbp, value) ;
-		}
-		else {
-		    status = dbp->set_re_delim(dbp, value) ;
-		}
-
-            }
-
-	   if (fixed) {
-               svp = hv_fetch(action, "reclen", 6, FALSE);
-	       if (svp) {
-		   u_int32_t len =  my_SvUV32(*svp) ;
-                   status = dbp->set_re_len(dbp, len) ;
-	       }    
-	   }
-         
-	    if (name != NULL) {
-	        status = dbp->set_re_source(dbp, name) ;
-	        name = NULL ;
-	    }	
-
-            svp = hv_fetch(action, "bfname", 6, FALSE); 
-            if (svp && SvOK(*svp)) {
-		char * ptr = SvPV(*svp,n_a) ;
-		name = (char*) n_a ? ptr : NULL ;
-	    }
-	    else
-		name = NULL ;
-         
-
-	    status = dbp->set_flags(dbp, (u_int32_t)DB_RENUMBER) ;
-         
-		if (flags){
-	            (void)dbp->set_flags(dbp, (u_int32_t)flags) ;
-		}
-            PrintRecno(info) ;
-        }
-        else
-            croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO");
-    }
-
-    {
-        u_int32_t 	Flags = 0 ;
-        int		status ;
-
-        /* Map 1.x flags to 3.x flags */
-        if ((flags & O_CREAT) == O_CREAT)
-            Flags |= DB_CREATE ;
-
-#if O_RDONLY == 0
-        if (flags == O_RDONLY)
-#else
-        if ((flags & O_RDONLY) == O_RDONLY && (flags & O_RDWR) != O_RDWR)
-#endif
-            Flags |= DB_RDONLY ;
-
-#ifdef O_TRUNC
-        if ((flags & O_TRUNC) == O_TRUNC)
-            Flags |= DB_TRUNCATE ;
-#endif
-
-#ifdef AT_LEAST_DB_4_4
-        /* need this for recno */
-        if ((flags & O_TRUNC) == O_TRUNC)
-            Flags |= DB_CREATE ;
-#endif
-
-#ifdef AT_LEAST_DB_4_1
-        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 
-	    			Flags, mode) ; 
-#else
-        status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type, 
-	    			Flags, mode) ; 
-#endif
-	/* printf("open returned %d %s\n", status, db_strerror(status)) ; */
-
-        if (status == 0) {
-
-            status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor,
-			0) ;
-	    /* printf("cursor returned %d %s\n", status, db_strerror(status)) ; */
-	}
-
-        if (status)
-	    RETVAL->dbp = NULL ;
-
-    }
-
-    return (RETVAL) ;
-
-#endif /* Berkeley DB Version > 2 */
-
-} /* ParseOpenInfo */
-
-
-#include "constants.h"   
-
-MODULE = DB_File	PACKAGE = DB_File	PREFIX = db_
-
-INCLUDE: constants.xs
-
-BOOT:
-  {
-#ifdef dTHX
-    dTHX;
-#endif    
-#ifdef WANT_ERROR
-    SV * sv_err = perl_get_sv(ERR_BUFF, GV_ADD|GV_ADDMULTI) ; 
-#endif
-    MY_CXT_INIT;
-    __getBerkeleyDBInfo() ;
- 
-    DBT_clear(empty) ; 
-    empty.data = &zero ;
-    empty.size =  sizeof(recno_t) ;
-  }
-
-
-
-DB_File
-db_DoTie_(isHASH, dbtype, name=undef, flags=O_CREAT|O_RDWR, mode=0666, type=DB_HASH)
-	int		isHASH
-	char *		dbtype
-	int		flags
-	int		mode
-	CODE:
-	{
-	    char *	name = (char *) NULL ; 
-	    SV *	sv = (SV *) NULL ; 
-	    STRLEN	n_a;
-
-	    if (items >= 3 && SvOK(ST(2))) 
-	        name = (char*) SvPV(ST(2), n_a) ; 
-
-            if (items == 6)
-	        sv = ST(5) ;
-
-	    RETVAL = ParseOpenInfo(aTHX_ isHASH, name, flags, mode, sv) ;
-	    if (RETVAL->dbp == NULL) {
-	        Safefree(RETVAL);
-	        RETVAL = NULL ;
-	    }
-	}
-	OUTPUT:	
-	    RETVAL
-
-int
-db_DESTROY(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT;
-	INIT:
-	  CurrentDB = db ;
-	  Trace(("DESTROY %p\n", db));
-	CLEANUP:
-	  Trace(("DESTROY %p done\n", db));
-	  if (db->hash)
-	    SvREFCNT_dec(db->hash) ;
-	  if (db->compare)
-	    SvREFCNT_dec(db->compare) ;
-	  if (db->prefix)
-	    SvREFCNT_dec(db->prefix) ;
-	  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) ;
-	  safefree(db) ;
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-#endif
-
-
-int
-db_DELETE(db, key, flags=0)
-	DB_File		db
-	DBTKEY		key
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	INIT:
-	  CurrentDB = db ;
-
-
-int
-db_EXISTS(db, key)
-	DB_File		db
-	DBTKEY		key
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	{
-          DBT		value ;
-	
-	  DBT_clear(value) ; 
-	  CurrentDB = db ;
-	  RETVAL = (((db->dbp)->get)(db->dbp, TXN &key, &value, 0) == 0) ;
-	}
-	OUTPUT:
-	  RETVAL
-
-void
-db_FETCH(db, key, flags=0)
-	DB_File		db
-	DBTKEY		key
-	u_int		flags
-	PREINIT:
-	  dMY_CXT ;
-	  int RETVAL ;
-	CODE:
-	{
-            DBT		value ;
-
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-	    RETVAL = db_get(db, key, value, flags) ;
-	    ST(0) = sv_newmortal();
-	    OutputValue(ST(0), value)
-	}
-
-int
-db_STORE(db, key, value, flags=0)
-	DB_File		db
-	DBTKEY		key
-	DBT		value
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	INIT:
-	  CurrentDB = db ;
-
-
-void
-db_FIRSTKEY(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT ;
-	  int RETVAL ;
-	CODE:
-	{
-	    DBTKEY	key ;
-	    DBT		value ;
-
-	    DBT_clear(key) ; 
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;
-	    ST(0) = sv_newmortal();
-	    OutputKey(ST(0), key) ;
-	}
-
-void
-db_NEXTKEY(db, key)
-	DB_File		db
-	DBTKEY		key = NO_INIT
-	PREINIT:
-	  dMY_CXT ;
-	  int RETVAL ;
-	CODE:
-	{
-	    DBT		value ;
-
-	    DBT_clear(key) ; 
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-	    RETVAL = do_SEQ(db, key, value, R_NEXT) ;
-	    ST(0) = sv_newmortal();
-	    OutputKey(ST(0), key) ;
-	}
-
-#
-# These would be nice for RECNO
-#
-
-int
-unshift(db, ...)
-	DB_File		db
-	ALIAS:		UNSHIFT = 1
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	{
-	    DBTKEY	key ;
-	    DBT		value ;
-	    int		i ;
-	    int		One ;
-	    STRLEN	n_a;
-
-	    DBT_clear(key) ; 
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-#ifdef DB_VERSION_MAJOR
-	    /* get the first value */
-	    RETVAL = do_SEQ(db, key, value, DB_FIRST) ;	 
-	    RETVAL = 0 ;
-#else
-	    RETVAL = -1 ;
-#endif
-	    for (i = items-1 ; i > 0 ; --i)
-	    {
-		DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
-	        value.data = SvPVbyte(ST(i), n_a) ;
-	        value.size = n_a ;
-	        One = 1 ;
-	        key.data = &One ;
-	        key.size = sizeof(int) ;
-#ifdef DB_VERSION_MAJOR
-           	RETVAL = (db->cursor->c_put)(db->cursor, &key, &value, DB_BEFORE) ;
-#else
-	        RETVAL = (db->dbp->put)(db->dbp, &key, &value, R_IBEFORE) ;
-#endif
-	        if (RETVAL != 0)
-	            break;
-	    }
-	}
-	OUTPUT:
-	    RETVAL
-
-void
-pop(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT;
-	ALIAS:		POP = 1
-	PREINIT:
-	  I32 RETVAL;
-	CODE:
-	{
-	    DBTKEY	key ;
-	    DBT		value ;
-
-	    DBT_clear(key) ; 
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-
-	    /* First get the final value */
-	    RETVAL = do_SEQ(db, key, value, R_LAST) ;	 
-	    ST(0) = sv_newmortal();
-	    /* Now delete it */
-	    if (RETVAL == 0)
-	    {
-		/* the call to del will trash value, so take a copy now */
-		OutputValue(ST(0), value) ;
-	        RETVAL = db_del(db, key, R_CURSOR) ;
-	        if (RETVAL != 0) 
-	            sv_setsv(ST(0), &PL_sv_undef); 
-	    }
-	}
-
-void
-shift(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT;
-	ALIAS:		SHIFT = 1
-	PREINIT:
-	  I32 RETVAL;
-	CODE:
-	{
-	    DBT		value ;
-	    DBTKEY	key ;
-
-	    DBT_clear(key) ; 
-	    DBT_clear(value) ; 
-	    CurrentDB = db ;
-	    /* get the first value */
-	    RETVAL = do_SEQ(db, key, value, R_FIRST) ;	 
-	    ST(0) = sv_newmortal();
-	    /* Now delete it */
-	    if (RETVAL == 0)
-	    {
-		/* the call to del will trash value, so take a copy now */
-		OutputValue(ST(0), value) ;
-	        RETVAL = db_del(db, key, R_CURSOR) ;
-	        if (RETVAL != 0)
-	            sv_setsv (ST(0), &PL_sv_undef) ;
-	    }
-	}
-
-
-I32
-push(db, ...)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT;
-	ALIAS:		PUSH = 1
-	CODE:
-	{
-	    DBTKEY	key ;
-	    DBT		value ;
-	    DB *	Db = db->dbp ;
-	    int		i ;
-	    STRLEN	n_a;
-	    int		keyval ;
-
-	    DBT_flags(key) ; 
-	    DBT_flags(value) ; 
-	    CurrentDB = db ;
-	    /* Set the Cursor to the Last element */
-	    RETVAL = do_SEQ(db, key, value, R_LAST) ;
-#ifndef DB_VERSION_MAJOR		    		    
-	    if (RETVAL >= 0)
-#endif	    
-	    {
-	    	if (RETVAL == 0)
-		    keyval = *(int*)key.data ;
-		else
-		    keyval = 0 ;
-	        for (i = 1 ; i < items ; ++i)
-	        {
-		    DBM_ckFilter(ST(i), filter_store_value, "filter_store_value");
-	            value.data = SvPVbyte(ST(i), n_a) ;
-	            value.size = n_a ;
-		    ++ keyval ;
-	            key.data = &keyval ;
-	            key.size = sizeof(int) ;
-		    RETVAL = (Db->put)(Db, TXN &key, &value, 0) ;
-	            if (RETVAL != 0)
-	                break;
-	        }
-	    }
-	}
-	OUTPUT:
-	    RETVAL
-
-I32
-length(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT;
-	ALIAS:		FETCHSIZE = 1
-	CODE:
-	    CurrentDB = db ;
-	    RETVAL = GetArrayLength(aTHX_ db) ;
-	OUTPUT:
-	    RETVAL
-
-
-#
-# Now provide an interface to the rest of the DB functionality
-#
-
-int
-db_del(db, key, flags=0)
-	DB_File		db
-	DBTKEY		key
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	  CurrentDB = db ;
-	  RETVAL = db_del(db, key, flags) ;
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-	  else if (RETVAL == DB_NOTFOUND)
-	    RETVAL = 1 ;
-#endif
-	OUTPUT:
-	  RETVAL
-
-
-int
-db_get(db, key, value, flags=0)
-	DB_File		db
-	DBTKEY		key
-	DBT		value = NO_INIT
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	  CurrentDB = db ;
-	  DBT_clear(value) ; 
-	  RETVAL = db_get(db, key, value, flags) ;
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-	  else if (RETVAL == DB_NOTFOUND)
-	    RETVAL = 1 ;
-#endif
-	OUTPUT:
-	  RETVAL
-	  value
-
-int
-db_put(db, key, value, flags=0)
-	DB_File		db
-	DBTKEY		key
-	DBT		value
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	  CurrentDB = db ;
-	  RETVAL = db_put(db, key, value, flags) ;
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-	  else if (RETVAL == DB_KEYEXIST)
-	    RETVAL = 1 ;
-#endif
-	OUTPUT:
-	  RETVAL
-	  key		if (flagSet(flags, R_IAFTER) || flagSet(flags, R_IBEFORE)) OutputKey(ST(1), key);
-
-int
-db_fd(db)
-	DB_File		db
-	PREINIT:
-	  dMY_CXT ;
-	CODE:
-	  CurrentDB = db ;
-#ifdef DB_VERSION_MAJOR
-	  RETVAL = -1 ;
-	  {
-	    int	status = 0 ;
-	    status = (db->in_memory
-		      ? -1 
-		      : ((db->dbp)->fd)(db->dbp, &RETVAL) ) ;
-	    if (status != 0)
-	      RETVAL = -1 ;
-	  }
-#else
-	  RETVAL = (db->in_memory
-		? -1 
-		: ((db->dbp)->fd)(db->dbp) ) ;
-#endif
-	OUTPUT:
-	  RETVAL
-
-int
-db_sync(db, flags=0)
-	DB_File		db
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	  CurrentDB = db ;
-	  RETVAL = db_sync(db, flags) ;
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-#endif
-	OUTPUT:
-	  RETVAL
-
-
-int
-db_seq(db, key, value, flags)
-	DB_File		db
-	DBTKEY		key 
-	DBT		value = NO_INIT
-	u_int		flags
-	PREINIT:
-	  dMY_CXT;
-	CODE:
-	  CurrentDB = db ;
-	  DBT_clear(value) ; 
-	  RETVAL = db_seq(db, key, value, flags);
-#ifdef DB_VERSION_MAJOR
-	  if (RETVAL > 0)
-	    RETVAL = -1 ;
-	  else if (RETVAL == DB_NOTFOUND)
-	    RETVAL = 1 ;
-#endif
-	OUTPUT:
-	  RETVAL
-	  key
-	  value
-
-SV *
-filter_fetch_key(db, code)
-	DB_File		db
-	SV *		code
-	SV *		RETVAL = &PL_sv_undef ;
-	CODE:
-	    DBM_setFilter(db->filter_fetch_key, code) ;
-
-SV *
-filter_store_key(db, code)
-	DB_File		db
-	SV *		code
-	SV *		RETVAL = &PL_sv_undef ;
-	CODE:
-	    DBM_setFilter(db->filter_store_key, code) ;
-
-SV *
-filter_fetch_value(db, code)
-	DB_File		db
-	SV *		code
-	SV *		RETVAL = &PL_sv_undef ;
-	CODE:
-	    DBM_setFilter(db->filter_fetch_value, code) ;
-
-SV *
-filter_store_value(db, code)
-	DB_File		db
-	SV *		code
-	SV *		RETVAL = &PL_sv_undef ;
-	CODE:
-	    DBM_setFilter(db->filter_store_value, code) ;
-
diff --git a/ext/DB_File/DB_File_BS b/ext/DB_File/DB_File_BS
deleted file mode 100644
index 9282c49881..0000000000
--- a/ext/DB_File/DB_File_BS
+++ /dev/null
@@ -1,6 +0,0 @@
-# NeXT needs /usr/lib/libposix.a to load along with DB_File.so
-if ( $dlsrc eq "dl_next.xs" ) {
-    @DynaLoader::dl_resolve_using = ( '/usr/lib/libposix.a' );
-}
-
-1;
diff --git a/ext/DB_File/Makefile.PL b/ext/DB_File/Makefile.PL
deleted file mode 100644
index a586a0445c..0000000000
--- a/ext/DB_File/Makefile.PL
+++ /dev/null
@@ -1,358 +0,0 @@
-#! perl -w
-
-use strict ;
-use ExtUtils::MakeMaker 5.16 ;
-use Config ;
-
-die "DB_File needs Perl 5.004_05 or better. This is $]\n" 
-    if $] <= 5.00404; 
-
-my $VER_INFO ;
-my $LIB_DIR ;
-my $INC_DIR ;
-my $DB_NAME ;
-my $LIBS ;
-my $COMPAT185 = "" ;
-
-ParseCONFIG() ;
-
-my @files = ('DB_File.pm', glob "t/*.t") ;
-UpDowngrade(@files);
-
-if (defined $DB_NAME)
-  { $LIBS = $DB_NAME }
-else {
-    if ($^O eq 'MSWin32')
-      { $LIBS = $Config{cc} =~ /gcc/ ? '-ldb' : '-llibdb' }
-    else
-      { $LIBS = '-ldb' }
-}
-
-# Solaris is special.
-#$LIBS .= " -lthread" if $^O eq 'solaris' ;
-
-# AIX is special.
-$LIBS .= " -lpthread" if $^O eq 'aix' ;
-
-# OS2 is a special case, so check for it now.
-my $OS2 = "" ;
-$OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
-
-my $WALL = '' ;
-#$WALL = ' -Wall ';
-
-WriteMakefile(
-	NAME 		=> 'DB_File',
-	LIBS 		=> ["-L${LIB_DIR} $LIBS"],
-	INC		=> "-I$INC_DIR",
-    VERSION_FROM	=> 'DB_File.pm',
-	XS_VERSION      => eval MM->parse_version('DB_File.pm'),
-	XSPROTOARG	=> '-noprototypes',
-	DEFINE		=> "-D_NOT_CORE $OS2 $VER_INFO $COMPAT185 $WALL",
-	OBJECT		=> 'version$(OBJ_EXT) DB_File$(OBJ_EXT)',
-    ((ExtUtils::MakeMaker->VERSION() gt '6.30') 
-        ?  ('LICENSE'  => 'perl')         
-        : ()
-    ),
-    (
-    $] >= 5.005
-        ? (ABSTRACT_FROM => 'DB_File.pm',
-            AUTHOR       => 'Paul Marquess <pmqs@cpan.org>')
-        : ()
-    ),
-    
-
-	#OPTIMIZE	=> '-g',
-	'depend'	=> { 'Makefile'          => 'config.in',
-                             'version$(OBJ_EXT)' => 'version.c'},
-	'clean'		=> { FILES => 'constants.h constants.xs' },
-	'macro'		=> { INSTALLDIRS => 'perl', my_files => "@files" },
-        'dist'          => { COMPRESS => 'gzip', SUFFIX => 'gz',
-			     DIST_DEFAULT => 'MyDoubleCheck tardist'},    
-	);
-
-
-my @names = qw(
-	BTREEMAGIC
-	BTREEVERSION
-	DB_LOCK
-	DB_SHMEM
-	DB_TXN
-	HASHMAGIC
-	HASHVERSION
-	MAX_PAGE_NUMBER
-	MAX_PAGE_OFFSET
-	MAX_REC_NUMBER
-	RET_ERROR
-	RET_SPECIAL
-	RET_SUCCESS
-	R_CURSOR
-	R_DUP
-	R_FIRST
-	R_FIXEDLEN
-	R_IAFTER
-	R_IBEFORE
-	R_LAST
-	R_NEXT
-	R_NOKEY
-	R_NOOVERWRITE
-	R_PREV
-	R_RECNOSYNC
-	R_SETCURSOR
-	R_SNAPSHOT
-	__R_UNUSED
-	);
-
-if (eval {require ExtUtils::Constant; 1}) {
-    # Check the constants above all appear in @EXPORT in DB_File.pm
-    my %names = map { $_, 1} @names;
-    open F, "<DB_File.pm" or die "Cannot open DB_File.pm: $!\n";
-    while (<F>)
-    {
-        last if /^\s*\@EXPORT\s+=\s+qw\(/ ;
-    }
-
-    while (<F>)
-    {
-        last if /^\s*\)/ ;
-        /(\S+)/ ;
-        delete $names{$1} if defined $1 ;
-    }
-    close F ;
-
-    if ( keys %names )
-    {
-        my $missing = join ("\n\t", sort keys %names) ;
-        die "The following names are missing from \@EXPORT in DB_File.pm\n" .
-            "\t$missing\n" ;
-    }
-    
-
-    ExtUtils::Constant::WriteConstants(
-                                     NAME => 'DB_File',
-                                     NAMES => \@names,
-                                     C_FILE  => 'constants.h',
-                                     XS_FILE  => 'constants.xs',
-                                                                       
-                                    );
-} 
-else {
-    use File::Copy;
-    copy ('fallback.h', 'constants.h')
-      or die "Can't copy fallback.h to constants.h: $!";
-    copy ('fallback.xs', 'constants.xs')
-      or die "Can't copy fallback.xs to constants.xs: $!";
-}
-
-exit;
-
-
-sub MY::libscan
-{
-    my $self = shift ;
-    my $path = shift ;
-
-    return undef
-        if $path =~ /(~|\.bak)$/ || 
-           $path =~ /^\..*\.swp$/ ;
-
-    return $path;    
-}
-
-
-sub MY::postamble { <<'EOM' } ;
-
-MyDoubleCheck:
-	@echo Checking config.in is setup for a release
-	@(grep "^LIB.*/usr/local/BerkeleyDB" config.in && 	\
-	grep "^INCLUDE.*/usr/local/BerkeleyDB" config.in &&	\
-	grep "^#DBNAME.*" config.in) >/dev/null ||		\
-	    (echo config.in needs fixing ; exit 1)
-	@echo config.in is ok
-	@echo 
-	@echo Checking DB_File.xs is ok for a release.
-	@(perl -ne ' exit 1 if /^\s*#\s*define\s+TRACE/ ; ' DB_File.xs || \
-	    (echo DB_File.xs needs fixing ; exit 1))
-	@echo DB_File.xs is ok
-	@echo 
-	@echo Checking for $$^W in files: $(my_files)
-	@perl -ne '						\
-	    exit 1 if /^\s*local\s*\(\s*\$$\^W\s*\)/;' $(my_files) ||	\
-	  (echo found unexpected $$^W ; exit 1)
-	@echo No $$^W found.
-	@echo 
-	@echo Checking for 'use vars' in files: $(my_files)
-	@perl -ne '						\
-	    exit 0 if /^__(DATA|END)__/;               	\
-	    exit 1 if /^\s*use\s+vars/;' $(my_files) ||	\
-	  (echo found unexpected "use vars"; exit 1)
-	@echo No 'use vars' found.
-	@echo 
-	@echo All files are OK for a release.
-	@echo 
-
-EOM
-
-
-
-sub ParseCONFIG
-{
-    my ($k, $v) ;
-    my @badkey = () ;
-    my %Info = () ;
-    my @Options = qw( INCLUDE LIB PREFIX HASH DBNAME COMPAT185 ) ;
-    my %ValidOption = map {$_, 1} @Options ;
-    my %Parsed = %ValidOption ;
-    my $CONFIG = 'config.in' ;
-
-    print "Parsing $CONFIG...\n" ;
-
-    # DBNAME & COMPAT185 are optional, so pretend they  have 
-    # been parsed.
-    delete $Parsed{'DBNAME'} ;
-    delete $Parsed{'COMPAT185'} ;
-    $Info{COMPAT185} = "No" ;
-
-
-    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{'DB_FILE_INCLUDE'} || $Info{'INCLUDE'} ;
-    $LIB_DIR = $ENV{'DB_FILE_LIB'} || $Info{'LIB'} ;
-    $DB_NAME = $ENV{'DB_FILE_NAME'} || $Info{'DBNAME'} ;
-    $COMPAT185 = "-DCOMPAT185 -DDB_LIBRARY_COMPATIBILITY_API" 
-        if (defined $ENV{'DB_FILE_COMPAT185'} && 
-		$ENV{'DB_FILE_COMPAT185'} =~ /^\s*(on|true|1)\s*$/i) ||
-		$Info{'COMPAT185'} =~ /^\s*(on|true|1)\s*$/i ; 
-    my $PREFIX  = $Info{'PREFIX'} ;
-    my $HASH    = $Info{'HASH'} ;
-
-    $VER_INFO = "-DmDB_Prefix_t=${PREFIX} -DmDB_Hash_t=${HASH}" ;
-
-    print <<EOM if 0 ;
-    INCLUDE	[$INC_DIR]
-    LIB		[$LIB_DIR]
-    HASH	[$HASH]
-    PREFIX	[$PREFIX]
-    DBNAME      [$DB_NAME]
-
-EOM
-
-    print "Looks Good.\n" ;
-
-}
-
-sub UpDowngrade
-{
-    my @files = @_ ;
-
-    # our      is stable from 5.6.0 onward
-    # warnings is stable from 5.6.1 onward
-
-    # Note: this code assumes that each statement it modifies is not
-    #       split across multiple lines.
-
-
-    my $warn_sub ;
-    my $our_sub ;
-
-    if ($] < 5.006001) {
-        # From: use|no warnings "blah"
-        # To:   local ($^W) = 1; # use|no warnings "blah"
-        #
-        # and
-        #
-        # From: warnings::warnif(x,y);
-        # To:   $^W && carp(y); # warnif -- x
-        $warn_sub = sub {
-	    s/^(\s*)(no\s+warnings)/${1}local (\$^W) = 0; #$2/ ;
-	    s/^(\s*)(use\s+warnings)/${1}local (\$^W) = 1; #$2/ ;
-
-	    s/^(\s*)warnings::warnif\s*\((.*?)\s*,\s*(.*?)\)\s*;/${1}\$^W && carp($3); # warnif - $2/ ;
-          };
-    }
-    else {
-        # From: local ($^W) = 1; # use|no warnings "blah"
-        # To:   use|no warnings "blah"
-        #
-        # and
-        #
-        # From: $^W && carp(y); # warnif -- x
-        # To:   warnings::warnif(x,y);
-        $warn_sub = sub {
-	    s/^(\s*)local\s*\(\$\^W\)\s*=\s*\d+\s*;\s*#\s*((no|use)\s+warnings.*)/$1$2/ ;
-	    s/^(\s*)\$\^W\s+\&\&\s*carp\s*\((.*?)\)\s*;\s*#\s*warnif\s*-\s*(.*)/${1}warnings::warnif($3, $2);/ ;
-          };
-    }
-
-    if ($] < 5.006000) {
-        $our_sub = sub {
-	    if ( /^(\s*)our\s+\(\s*([^)]+\s*)\)/ ) {
-                my $indent = $1;
-                my $vars = join ' ', split /\s*,\s*/, $2;
-                $_ = "${indent}use vars qw($vars);\n";
-            }
-          };
-    }
-    else {
-        $our_sub = sub {
-	    if ( /^(\s*)use\s+vars\s+qw\((.*?)\)/ ) {
-                my $indent = $1;
-                my $vars = join ', ', split ' ', $2;
-                $_ = "${indent}our ($vars);\n";
-            }
-          };
-    }
-
-    foreach (@files)
-      { doUpDown($our_sub, $warn_sub, $_) }
-}
-
-
-sub doUpDown
-{
-    my $our_sub = shift;
-    my $warn_sub = shift;
-
-    local ($^I) = ".bak" ;
-    local (@ARGV) = shift;
-
-    while (<>)
-    {
-	print, last if /^__(END|DATA)__/ ;
-
-	&{ $our_sub }();
-	&{ $warn_sub }();
-	print ;
-    }
-
-    return if eof ;
-
-    while (<>)
-      { print }
-}
-
-# end of file Makefile.PL
diff --git a/ext/DB_File/config.in b/ext/DB_File/config.in
deleted file mode 100755
index 292b09a5fb..0000000000
--- a/ext/DB_File/config.in
+++ /dev/null
@@ -1,97 +0,0 @@
-# Filename:	config.in
-#
-# written by Paul Marquess <Paul.Marquess@btinternet.com>
-# last modified 9th Sept 1997
-# version 1.55
-
-# 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/BerkeleyDB/include
-#INCLUDE	= /usr/local/include
-#INCLUDE	= /usr/include
-
-# 2. Where is libdb?
-#
-#    Change the path below to point to the directory where libdb is
-#    installed on your system.
-
-LIB	= /usr/local/BerkeleyDB/lib
-#LIB	= /usr/local/lib
-#LIB	= /usr/lib
-
-# 3. What version of Berkely DB have you got?
-#
-#    If you have version 2.0 or greater, you can skip this question.
-#
-#    If you have Berkeley DB 1.78 or greater you shouldn't have to
-#    change the definitions for PREFIX and HASH below.
-#
-#    For older versions of Berkeley DB change both PREFIX and HASH to int.
-#    Version 1.71, 1.72 and 1.73 are known to need this change.
-#
-#    If you don't know what version you have have a look in the file db.h. 
-#
-#    Search for the string "DB_VERSION_MAJOR". If it is present, you
-#    have Berkeley DB version 2 (or greater).
-#
-#    If that didn't work, find the definition of the BTREEINFO typedef.
-#    Check the return type from the prefix element. It should look like
-#    this in an older copy of db.h:
-#
-#        int      (*prefix)      __P((const DBT *, const DBT *));  
-#
-#    and like this in a more recent copy:
-#
-#        size_t  (*prefix)       /* prefix function */
-#            __P((const DBT *, const DBT *));
-#
-#    Change the definition of PREFIX, below, to reflect the return type
-#    of the prefix function in your db.h.
-#
-#    Now find the definition of the HASHINFO typedef. Check the return
-#    type of the hash element. Older versions look like this:
-#
-#        int      (*hash) __P((const void *, size_t));      
-#
-#    newer like this:
-#
-#        u_int32_t               /* hash function */
-#                (*hash) __P((const void *, size_t));
-#
-#    Change the definition of HASH, below, to reflect the return type of
-#    the hash function in your db.h.
-#
-
-PREFIX	=	size_t
-HASH	=	u_int32_t
-
-# 4. 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 both Berkeley DB 2.3.12 and 1.85 on your
-#    system and you want to use the Berkeley DB version 2 library you
-#    could rename the version 2 library from libdb.a to libdb-2.3.12.a and
-#    change the DBNAME line below to look like this:
-#
-#        DBNAME = -ldb-2.3.12
-#
-#    That will ensure you are linking the correct version of the DB
-#    library.
-#
-#    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-2.4.10
-
-# end of file config.in
diff --git a/ext/DB_File/dbinfo b/ext/DB_File/dbinfo
deleted file mode 100644
index b8cd65a9a2..0000000000
--- a/ext/DB_File/dbinfo
+++ /dev/null
@@ -1,133 +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.06 
-# Date		27th March 2008
-#
-#     Copyright (c) 1998-2008 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 =>	# DB_BTREEMAGIC
-            {
-			  Type 	   => "Btree",
-			  Versions => # DB_BTREEVERSION
-				{
-				  1	=> [0, "Unknown (older than 1.71)"],
-				  2	=> [0, "Unknown (older than 1.71)"],
-				  3	=> [0, "1.71 -> 1.85, 1.86"],
-				  4	=> [0, "Unknown"],
-				  5	=> [0, "2.0.0 -> 2.3.0"],
-				  6	=> [0, "2.3.1 -> 2.7.7"],
-				  7	=> [0, "3.0.x"],
-				  8	=> [0, "3.1.x -> 4.0.x"],
-				  9	=> [1, "4.1.x or greater"],
-				}
-			},
-	0x061561 => 	# DB_HASHMAGIC
-            {
-			  Type     => "Hash",
-			  Versions => # DB_HASHVERSION
-				{
-				  1	=> [0, "Unknown (older than 1.71)"],
-        			  2     => [0, "1.71 -> 1.85"],
-        			  3     => [0, "1.86"],
-        			  4     => [0, "2.0.0 -> 2.1.0"],
-        			  5     => [0, "2.2.6 -> 2.7.7"],
-        			  6     => [0, "3.0.x"],
-				  7	=> [0, "3.1.x -> 4.0.x"],
-				  8	=> [1, "4.1.x or greater"],
-				  9	=> [1, "4.6.x or greater"],
-				}
-			},
-	0x042253 => 	# DB_QAMMAGIC
-            {
-			  Type     => "Queue",
-			  Versions => # DB_QAMVERSION
-				{
-				  1	=> [0, "3.0.x"],
-				  2	=> [0, "3.1.x"],
-				  3	=> [0, "3.2.x -> 4.0.x"],
-				  4	=> [1, "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, 30 ;
-
-
-my (@info) = unpack("NNNNNNC", $buff) ;
-my (@info1) = unpack("VVVVVVC", $buff) ;
-my ($magic, $version, $endian, $encrypt) ;
-
-if ($Data{$info[0]}) # first try DB 1.x format, big endian
-{
-    $magic = $info[0] ;
-    $version = $info[1] ;
-    $endian  = "Big Endian" ;
-    $encrypt = "Not Supported";
-}
-elsif ($Data{$info1[0]}) # first try DB 1.x format, little endian
-{
-    $magic = $info1[0] ;
-    $version = $info1[1] ;
-    $endian  = "Little Endian" ;
-    $encrypt = "Not Supported";
-}
-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" ;
-
-if ( defined $type->{Versions}{$version} )
-{
-     $ver_string = $type->{Versions}{$version}[1];
-     if ($type->{Versions}{$version}[0] )
-       { $encrypt = $info[6] ? "Enabled" : "Disabled" }
-     else
-       { $encrypt = "Not Supported" }
-}
-
-print <<EOM ;
-File Type:		Berkeley DB $type->{Type} file.
-File Version ID:	$version
-Built with Berkeley DB:	$ver_string
-Byte Order:		$endian
-Magic:			$magic
-Encryption:             $encrypt
-EOM
-
-close F ;
-
-exit ;
diff --git a/ext/DB_File/hints/dynixptx.pl b/ext/DB_File/hints/dynixptx.pl
deleted file mode 100644
index bb5ffa56e6..0000000000
--- a/ext/DB_File/hints/dynixptx.pl
+++ /dev/null
@@ -1,3 +0,0 @@
-# Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug
-
-$self->{LIBS} = ['-lm -lc'];
diff --git a/ext/DB_File/hints/sco.pl b/ext/DB_File/hints/sco.pl
deleted file mode 100644
index ff60440949..0000000000
--- a/ext/DB_File/hints/sco.pl
+++ /dev/null
@@ -1,2 +0,0 @@
-# osr5 needs to explicitly link against libc to pull in some static symbols
-$self->{LIBS} = ['-ldb -lc'] if $Config{'osvers'} =~ '3\.2v5\.0\..' ;
diff --git a/ext/DB_File/t/db-btree.t b/ext/DB_File/t/db-btree.t
deleted file mode 100644
index 0df890436b..0000000000
--- a/ext/DB_File/t/db-btree.t
+++ /dev/null
@@ -1,1657 +0,0 @@
-#!./perl -w
- 
-use warnings;
-use strict;
-use Config;
- 
-BEGIN {
-    if($ENV{PERL_CORE}) {
-        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
-            print "1..0 # Skip: DB_File was not built\n";
-            exit 0;
-        }
-    }
-}
-
-BEGIN
-{
-    if ($^O eq 'darwin'
-	&& (split(/\./, $Config{osvers}))[0] < 7 # Mac OS X 10.3 == Darwin 7
-	&& $Config{db_version_major} == 1
-	&& $Config{db_version_minor} == 0
-	&& $Config{db_version_patch} == 0) {
-	warn <<EOM;
-#
-# This test is known to crash in Mac OS X versions 10.2 (or earlier)
-# because of the buggy Berkeley DB version included with the OS.
-#
-EOM
-    }
-}
-
-use DB_File; 
-use Fcntl;
-
-print "1..197\n";
-
-unlink glob "__db.*";
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
- 
-    print "not " unless $result ;
-    print "ok $no\n" ;
-}
-
-sub lexical
-{
-    my(@a) = unpack ("C*", $a) ;
-    my(@b) = unpack ("C*", $b) ;
-
-    my $len = (@a > @b ? @b : @a) ;
-    my $i = 0 ;
-
-    foreach $i ( 0 .. $len -1) {
-        return $a[$i] - $b[$i] if $a[$i] != $b[$i] ;
-    }
-
-    return @a - @b ;
-}
-
-{
-    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);
-    $result = normalise($result) ;
-    return $result ;
-}   
-
-sub docat_del
-{ 
-    my $file = shift;
-    my $result = docat($file);
-    unlink $file ;
-    return $result ;
-}   
-
-sub normalise
-{
-    my $data = shift ;
-    $data =~ s#\r\n#\n#g 
-        if $^O eq 'cygwin' ;
-
-    return $data ;
-}
-
-sub safeUntie
-{
-    my $hashref = shift ;
-    my $no_inner = 1;
-    local $SIG{__WARN__} = sub {-- $no_inner } ;
-    untie %$hashref;
-    return $no_inner;
-}
-
-
-
-my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
-				|| $DB_File::db_ver >= 3.1 );
-
-my $Dfile = "dbbtree.tmp";
-unlink $Dfile;
-
-umask(0);
-
-# Check the interface to BTREEINFO
-
-my $dbh = new DB_File::BTREEINFO ;
-ok(1, ! defined $dbh->{flags}) ;
-ok(2, ! defined $dbh->{cachesize}) ;
-ok(3, ! defined $dbh->{psize}) ;
-ok(4, ! defined $dbh->{lorder}) ;
-ok(5, ! defined $dbh->{minkeypage}) ;
-ok(6, ! defined $dbh->{maxkeypage}) ;
-ok(7, ! defined $dbh->{compare}) ;
-ok(8, ! defined $dbh->{prefix}) ;
-
-$dbh->{flags} = 3000 ;
-ok(9, $dbh->{flags} == 3000) ;
-
-$dbh->{cachesize} = 9000 ;
-ok(10, $dbh->{cachesize} == 9000);
-
-$dbh->{psize} = 400 ;
-ok(11, $dbh->{psize} == 400) ;
-
-$dbh->{lorder} = 65 ;
-ok(12, $dbh->{lorder} == 65) ;
-
-$dbh->{minkeypage} = 123 ;
-ok(13, $dbh->{minkeypage} == 123) ;
-
-$dbh->{maxkeypage} = 1234 ;
-ok(14, $dbh->{maxkeypage} == 1234 );
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(15, $@ =~ /^DB_File::BTREEINFO::STORE - Unknown element 'fred' at/ ) ;
-eval 'my $q = $dbh->{fred}' ;
-ok(16, $@ =~ /^DB_File::BTREEINFO::FETCH - Unknown element 'fred' at/ ) ;
-
-# Now check the interface to BTREE
-
-my ($X, %h) ;
-ok(17, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ;
-die "Could not tie: $!" unless $X;
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-
-my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
-
-ok(18, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640)
-   || $noMode{$^O} );
-
-my ($key, $value, $i);
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(19, !$i ) ;
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-ok(20, $h{'abc'} eq 'ABC' );
-ok(21, ! defined $h{'jimmy'} ) ;
-ok(22, ! exists $h{'jimmy'} ) ;
-ok(23,  defined $h{'abc'} ) ;
-
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-
-#$h{'b'} = 'B';
-$X->STORE('b', 'B') ;
-
-$h{'c'} = 'C';
-
-#$h{'d'} = 'D';
-$X->put('d', 'D') ;
-
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'X';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-untie(%h);
-
-# tie to the same file again
-ok(24, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE)) ;
-
-# Modify an entry from the previous tie
-$h{'g'} = 'G';
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-$X->DELETE('goner3');
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-ok(25, $#keys == 29 && $#values == 29) ;
-
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-	$key =~ y/a-z/A-Z/;
-	$i++ if $key eq $value;
-    }
-}
-
-ok(26, $i == 30) ;
-
-@keys = ('blurfl', keys(%h), 'dyick');
-ok(27, $#keys == 31) ;
-
-#Check that the keys can be retrieved in order
-my @b = keys %h ;
-my @c = sort lexical @b ;
-ok(28, ArrayCompare(\@b, \@c)) ;
-
-$h{'foo'} = '';
-ok(29, $h{'foo'} eq '' ) ;
-
-# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
-# This feature was reenabled in version 3.1 of Berkeley DB.
-my $result = 0 ;
-if ($null_keys_allowed) {
-    $h{''} = 'bar';
-    $result = ( $h{''} eq 'bar' );
-}
-else
-  { $result = 1 }
-ok(30, $result) ;
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-ok(31, $ok);
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(32, $size > 0 );
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-ok(33, join(':',200..400) eq join(':',@foo) );
-
-# Now check all the non-tie specific stuff
-
-
-# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite
-# an existing record.
- 
-my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
-ok(34, $status == 1 );
- 
-# check that the value of the key 'x' has not been changed by the 
-# previous test
-ok(35, $h{'x'} eq 'X' );
-
-# standard put
-$status = $X->put('key', 'value') ;
-ok(36, $status == 0 );
-
-#check that previous put can be retrieved
-$value = 0 ;
-$status = $X->get('key', $value) ;
-ok(37, $status == 0 );
-ok(38, $value eq 'value' );
-
-# Attempting to delete an existing key should work
-
-$status = $X->del('q') ;
-ok(39, $status == 0 );
-if ($null_keys_allowed) {
-    $status = $X->del('') ;
-} else {
-    $status = 0 ;
-}
-ok(40, $status == 0 );
-
-# Make sure that the key deleted, cannot be retrieved
-ok(41, ! defined $h{'q'}) ;
-ok(42, ! defined $h{''}) ;
-
-undef $X ;
-untie %h ;
-
-ok(43, $X = tie(%h, 'DB_File',$Dfile, O_RDWR, 0640, $DB_BTREE ));
-
-# Attempting to delete a non-existant key should fail
-
-$status = $X->del('joe') ;
-ok(44, $status == 1 );
-
-# Check the get interface
-
-# First a non-existing key
-$status = $X->get('aaaa', $value) ;
-ok(45, $status == 1 );
-
-# Next an existing key
-$status = $X->get('a', $value) ;
-ok(46, $status == 0 );
-ok(47, $value eq 'A' );
-
-# seq
-# ###
-
-# use seq to find an approximate match
-$key = 'ke' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(48, $status == 0 );
-ok(49, $key eq 'key' );
-ok(50, $value eq 'value' );
-
-# seq when the key does not match
-$key = 'zzz' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(51, $status == 1 );
-
-
-# use seq to set the cursor, then delete the record @ the cursor.
-
-$key = 'x' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(52, $status == 0 );
-ok(53, $key eq 'x' );
-ok(54, $value eq 'X' );
-$status = $X->del(0, R_CURSOR) ;
-ok(55, $status == 0 );
-$status = $X->get('x', $value) ;
-ok(56, $status == 1 );
-
-# ditto, but use put to replace the key/value pair.
-$key = 'y' ;
-$value = '' ;
-$status = $X->seq($key, $value, R_CURSOR) ;
-ok(57, $status == 0 );
-ok(58, $key eq 'y' );
-ok(59, $value eq 'Y' );
-
-$key = "replace key" ;
-$value = "replace value" ;
-$status = $X->put($key, $value, R_CURSOR) ;
-ok(60, $status == 0 );
-ok(61, $key eq 'replace key' );
-ok(62, $value eq 'replace value' );
-$status = $X->get('y', $value) ;
-ok(63, 1) ; # hard-wire to always pass. the previous test ($status == 1)
-	    # only worked because of a bug in 1.85/6
-
-# use seq to walk forwards through a file 
-
-$status = $X->seq($key, $value, R_FIRST) ;
-ok(64, $status == 0 );
-my $previous = $key ;
-
-$ok = 1 ;
-while (($status = $X->seq($key, $value, R_NEXT)) == 0)
-{
-    ($ok = 0), last if ($previous cmp $key) == 1 ;
-}
-
-ok(65, $status == 1 );
-ok(66, $ok == 1 );
-
-# use seq to walk backwards through a file 
-$status = $X->seq($key, $value, R_LAST) ;
-ok(67, $status == 0 );
-$previous = $key ;
-
-$ok = 1 ;
-while (($status = $X->seq($key, $value, R_PREV)) == 0)
-{
-    ($ok = 0), last if ($previous cmp $key) == -1 ;
-    #print "key = [$key] value = [$value]\n" ;
-}
-
-ok(68, $status == 1 );
-ok(69, $ok == 1 );
-
-
-# check seq FIRST/LAST
-
-# sync
-# ####
-
-$status = $X->sync ;
-ok(70, $status == 0 );
-
-
-# fd
-# ##
-
-$status = $X->fd ;
-ok(71, 1 );
-#ok(71, $status != 0 );
-
-
-undef $X ;
-untie %h ;
-
-unlink $Dfile;
-
-# Now try an in memory file
-my $Y;
-ok(72, $Y = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_BTREE ));
-
-# fd with an in memory file should return failure
-$status = $Y->fd ;
-ok(73, $status == -1 );
-
-
-undef $Y ;
-untie %h ;
-
-# Duplicate keys
-my $bt = new DB_File::BTREEINFO ;
-$bt->{flags} = R_DUP ;
-my ($YY, %hh);
-ok(74, $YY = tie(%hh, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $bt )) ;
-
-$hh{'Wall'} = 'Larry' ;
-$hh{'Wall'} = 'Stone' ; # Note the duplicate key
-$hh{'Wall'} = 'Brick' ; # Note the duplicate key
-$hh{'Wall'} = 'Brick' ; # Note the duplicate key and value
-$hh{'Smith'} = 'John' ;
-$hh{'mouse'} = 'mickey' ;
-
-# first work in scalar context
-ok(75, scalar $YY->get_dup('Unknown') == 0 );
-ok(76, scalar $YY->get_dup('Smith') == 1 );
-ok(77, scalar $YY->get_dup('Wall') == 4 );
-
-# now in list context
-my @unknown = $YY->get_dup('Unknown') ;
-ok(78, "@unknown" eq "" );
-
-my @smith = $YY->get_dup('Smith') ;
-ok(79, "@smith" eq "John" );
-
-{
-my @wall = $YY->get_dup('Wall') ;
-my %wall ;
-@wall{@wall} = @wall ;
-ok(80, (@wall == 4 && $wall{'Larry'} && $wall{'Stone'} && $wall{'Brick'}) );
-}
-
-# hash
-my %unknown = $YY->get_dup('Unknown', 1) ;
-ok(81, keys %unknown == 0 );
-
-my %smith = $YY->get_dup('Smith', 1) ;
-ok(82, keys %smith == 1 && $smith{'John'}) ;
-
-my %wall = $YY->get_dup('Wall', 1) ;
-ok(83, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1 
-		&& $wall{'Brick'} == 2);
-
-undef $YY ;
-untie %hh ;
-unlink $Dfile;
-
-
-# test multiple callbacks
-my $Dfile1 = "btree1" ;
-my $Dfile2 = "btree2" ;
-my $Dfile3 = "btree3" ;
- 
-my $dbh1 = new DB_File::BTREEINFO ;
-$dbh1->{compare} = sub { 
-	no warnings 'numeric' ;
-	$_[0] <=> $_[1] } ; 
- 
-my $dbh2 = new DB_File::BTREEINFO ;
-$dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
- 
-my $dbh3 = new DB_File::BTREEINFO ;
-$dbh3->{compare} = sub { length $_[0] <=> length $_[1] } ;
- 
- 
-my (%g, %k);
-tie(%h, 'DB_File',$Dfile1, O_RDWR|O_CREAT, 0640, $dbh1 ) or die $!;
-tie(%g, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) or die $!;
-tie(%k, 'DB_File',$Dfile3, O_RDWR|O_CREAT, 0640, $dbh3 ) or die $!;
- 
-my @Keys = qw( 0123 12 -1234 9 987654321 def  ) ;
-my (@srt_1, @srt_2, @srt_3);
-{ 
-  no warnings 'numeric' ;
-  @srt_1 = sort { $a <=> $b } @Keys ; 
-}
-@srt_2 = sort { $a cmp $b } @Keys ;
-@srt_3 = sort { length $a <=> length $b } @Keys ;
- 
-foreach (@Keys) {
-    $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(84, ArrayCompare (\@srt_1, [keys %h]) );
-ok(85, ArrayCompare (\@srt_2, [keys %g]) );
-ok(86, ArrayCompare (\@srt_3, [keys %k]) );
-
-untie %h ;
-untie %g ;
-untie %k ;
-unlink $Dfile1, $Dfile2, $Dfile3 ;
-
-# clear
-# #####
-
-ok(87, tie(%h, 'DB_File', $Dfile1, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-foreach (1 .. 10)
-  { $h{$_} = $_ * 100 }
-
-# check that there are 10 elements in the hash
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(88, $i == 10);
-
-# now clear the hash
-%h = () ;
-
-# check it is empty
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(89, $i == 0);
-
-untie %h ;
-unlink $Dfile1 ;
-
-{
-    # check that attempting to tie an array to a DB_BTREE will fail
-
-    my $filename = "xyz" ;
-    my @x ;
-    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE ; } ;
-    ok(90, $@ =~ /^DB_File can only tie an associative array to a DB_BTREE database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   our (@ISA, @EXPORT);
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-	my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-	my $self = shift ;
-        $self->SUPER::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(91, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-	$X = tie(%h, "SubDB","dbbtree.tmp", O_RDWR|O_CREAT, 0640, $DB_BTREE );
-	' ;
-
-    main::ok(92, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(93, $@ eq "") ;
-    main::ok(94, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
-    main::ok(95, $@ eq "") ;
-    main::ok(96, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(97, $@ eq "" ) ;
-    main::ok(98, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method("joe") ' ;
-    main::ok(99, $@ eq "") ;
-    main::ok(100, $ret eq "[[11]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", "dbbtree.tmp" ;
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   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(101, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-   $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(102, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(103, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(104, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(105, $db->FIRSTKEY() eq "fred") ;
-   #                    fk     sk  fv  sv
-   ok(106, 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(107, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(108, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(109, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(110, $db->FIRSTKEY() eq "FRED") ;
-   #                   fk   sk     fv    sv
-   ok(111, 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(112, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(113, $h{"fred"} eq "joe");
-   ok(114, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(115, $db->FIRSTKEY() eq "fred") ;
-   ok(116, 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(117, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(118, $h{"fred"} eq "joe");
-   ok(119, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(120, $db->FIRSTKEY() eq "fred") ;
-   ok(121, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-
-    unlink $Dfile;
-    ok(122, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-    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(123, $result{"store key"} eq "store key - 1: [fred]");
-    ok(124, $result{"store value"} eq "store value - 1: [joe]");
-    ok(125, ! defined $result{"fetch key"} );
-    ok(126, ! defined $result{"fetch value"} );
-    ok(127, $_ eq "original") ;
-
-    ok(128, $db->FIRSTKEY() eq "fred") ;
-    ok(129, $result{"store key"} eq "store key - 1: [fred]");
-    ok(130, $result{"store value"} eq "store value - 1: [joe]");
-    ok(131, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(132, ! defined $result{"fetch value"} );
-    ok(133, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(134, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(135, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(136, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(137, ! defined $result{"fetch value"} );
-    ok(138, $_ eq "original") ;
-
-    ok(139, $h{"fred"} eq "joe");
-    ok(140, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(141, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(142, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(143, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(144, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}		
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   unlink $Dfile;
-
-   ok(145, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(146, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 1
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-
-    my %h ;
-
-    sub Compare
-    {
-        my ($key1, $key2) = @_ ;
-        "\L$key1" cmp "\L$key2" ;
-    }
-
-    # specify the Perl sub that will do the comparison
-    $DB_BTREE->{'compare'} = \&Compare ;
-
-    unlink "tree" ;
-    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE 
-        or die "Cannot open file 'tree': $!\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 "tree" ;
-  }  
-
-  delete $DB_BTREE->{'compare'} ;
-
-  ok(147, docat_del($file) eq <<'EOM') ;
-mouse
-Smith
-Wall
-EOM
-   
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 2
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-
-    my ($filename, %h);
-
-    $filename = "tree" ;
-    unlink $filename ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
-
-    # iterate through the associative array
-    # and print each key/value pair.
-    foreach (keys %h)
-      { print "$_	-> $h{$_}\n" }
-
-    untie %h ;
-
-    unlink $filename ;
-  }  
-
-  ok(148, docat_del($file) eq ($db185mode ? <<'EOM' : <<'EOM') ) ;
-Smith	-> John
-Wall	-> Brick
-Wall	-> Brick
-Wall	-> Brick
-mouse	-> mickey
-EOM
-Smith	-> John
-Wall	-> Larry
-Wall	-> Larry
-Wall	-> Larry
-mouse	-> mickey
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 3
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    my ($filename, $x, %h, $status, $key, $value);
-
-    $filename = "tree" ;
-    unlink $filename ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'Wall'} = 'Larry' ;
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key
-    $h{'Wall'} = 'Brick' ; # Note the duplicate key and value
-    $h{'Smith'} = 'John' ;
-    $h{'mouse'} = 'mickey' ;
- 
-    # iterate through the btree using seq
-    # and print each key/value pair.
-    $key = $value = 0 ;
-    for ($status = $x->seq($key, $value, R_FIRST) ;
-         $status == 0 ;
-         $status = $x->seq($key, $value, R_NEXT) )
-      {  print "$key	-> $value\n" }
- 
- 
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(149, docat_del($file) eq ($db185mode == 1 ? <<'EOM' : <<'EOM') ) ;
-Smith	-> John
-Wall	-> Brick
-Wall	-> Brick
-Wall	-> Larry
-mouse	-> mickey
-EOM
-Smith	-> John
-Wall	-> Larry
-Wall	-> Brick
-Wall	-> Brick
-mouse	-> mickey
-EOM
-
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 4
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    my ($filename, $x, %h);
-
-    $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
- 
-    my $cnt  = $x->get_dup("Wall") ;
-    print "Wall occurred $cnt times\n" ;
-
-    my %hash = $x->get_dup("Wall", 1) ;
-    print "Larry is there\n" if $hash{'Larry'} ;
-    print "There are $hash{'Brick'} Brick Walls\n" ;
-
-    my @list = sort $x->get_dup("Wall") ;
-    print "Wall =>	[@list]\n" ;
-
-    @list = $x->get_dup("Smith") ;
-    print "Smith =>	[@list]\n" ;
- 
-    @list = $x->get_dup("Dog") ;
-    print "Dog =>	[@list]\n" ; 
- 
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(150, docat_del($file) eq <<'EOM') ;
-Wall occurred 3 times
-Larry is there
-There are 2 Brick Walls
-Wall =>	[Brick Brick Larry]
-Smith =>	[John]
-Dog =>	[]
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 5
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    my ($filename, $x, %h, $found);
-
-    $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-    
-    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
-    print "Harry Wall is $found there\n" ;
-    
-    undef $x ;
-    untie %h ;
-  }
-
-  ok(151, docat_del($file) eq <<'EOM') ;
-Larry Wall is  there
-Harry Wall is not there
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 6
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
- 
-    my ($filename, $x, %h, $found);
-
-    $filename = "tree" ;
- 
-    # Enable duplicate records
-    $DB_BTREE->{'flags'} = R_DUP ;
- 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
-	or die "Cannot open $filename: $!\n";
-
-    $x->del_dup("Wall", "Larry") ;
-
-    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ; 
-    print "Larry Wall is $found there\n" ;
-    
-    undef $x ;
-    untie %h ;
-
-    unlink $filename ;
-  }
-
-  ok(152, docat_del($file) eq <<'EOM') ;
-Larry Wall is not there
-EOM
-
-  {
-    my $redirect = new Redirect $file ;
-
-    # BTREE example 7
-    ###
-
-    use warnings FATAL => qw(all) ;
-    use strict ;
-    use DB_File ;
-    use Fcntl ;
-
-    my ($filename, $x, %h, $st, $key, $value);
-
-    sub match
-    {
-        my $key = shift ;
-        my $value = 0;
-        my $orig_key = $key ;
-        $x->seq($key, $value, R_CURSOR) ;
-        print "$orig_key\t-> $key\t-> $value\n" ;
-    }
-
-    $filename = "tree" ;
-    unlink $filename ;
-
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE
-        or die "Cannot open $filename: $!\n";
- 
-    # Add some key/value pairs to the file
-    $h{'mouse'} = 'mickey' ;
-    $h{'Wall'} = 'Larry' ;
-    $h{'Walls'} = 'Brick' ; 
-    $h{'Smith'} = 'John' ;
- 
-
-    $key = $value = 0 ;
-    print "IN ORDER\n" ;
-    for ($st = $x->seq($key, $value, R_FIRST) ;
-	 $st == 0 ;
-         $st = $x->seq($key, $value, R_NEXT) )
-	
-      {  print "$key	-> $value\n" }
- 
-    print "\nPARTIAL MATCH\n" ;
-
-    match "Wa" ;
-    match "A" ;
-    match "a" ;
-
-    undef $x ;
-    untie %h ;
-
-    unlink $filename ;
-
-  }
-
-  ok(153, docat_del($file) eq <<'EOM') ;
-IN ORDER
-Smith	-> John
-Wall	-> Larry
-Walls	-> Brick
-mouse	-> mickey
-
-PARTIAL MATCH
-Wa	-> Wall	-> Larry
-A	-> Smith	-> John
-a	-> mouse	-> mickey
-EOM
-
-}
-
-#{
-#   # R_SETCURSOR
-#   use strict ;
-#   my (%h, $db) ;
-#   unlink $Dfile;
-#
-#   ok(156, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-#
-#   $h{abc} = 33 ;
-#   my $k = "newest" ;
-#   my $v = 44 ;
-#   my $status = $db->put($k, $v, R_SETCURSOR) ;
-#   print "status = [$status]\n" ;
-#   ok(157, $status == 0) ;
-#   $status = $db->del($k, R_CURSOR) ;
-#   print "status = [$status]\n" ;
-#   ok(158, $status == 0) ;
-#   $k = "newest" ;
-#   ok(159, $db->get($k, $v, R_CURSOR)) ;
-#
-#   ok(160, keys %h == 1) ;
-#   
-#   undef $db ;
-#   untie %h;
-#   unlink $Dfile;
-#}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
-	or die "Can't open file: $!\n" ;
-    $h{ABC} = undef;
-    ok(154, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_BTREE
-	or die "Can't open file: $!\n" ;
-    %h = (); ;
-    ok(155, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # When iterating over a tied hash using "each", the key passed to FETCH
-    # will be recycled and passed to NEXTKEY. If a Source Filter modifies the
-    # key in FETCH via a filter_fetch_key method we need to check that the
-    # modified key doesn't get passed to NEXTKEY.
-    # Also Test "keys" & "values" while we are at it.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my $bad_key = 0 ;
-    my %h = () ;
-    my $db ;
-    ok(156, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-    $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ;
-    $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ;
-
-    $h{'Alpha_ABC'} = 2 ;
-    $h{'Alpha_DEF'} = 5 ;
-
-    ok(157, $h{'Alpha_ABC'} == 2);
-    ok(158, $h{'Alpha_DEF'} == 5);
-
-    my ($k, $v) = ("","");
-    while (($k, $v) = each %h) {}
-    ok(159, $bad_key == 0);
-
-    $bad_key = 0 ;
-    foreach $k (keys %h) {}
-    ok(160, $bad_key == 0);
-
-    $bad_key = 0 ;
-    foreach $v (values %h) {}
-    ok(161, $bad_key == 0);
-
-    undef $db ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # now an error to pass 'compare' a non-code reference
-    my $dbh = new DB_File::BTREEINFO ;
-
-    eval { $dbh->{compare} = 2 };
-    ok(162, $@ =~ /^Key 'compare' not associated with a code reference at/);
-
-    eval { $dbh->{prefix} = 2 };
-    ok(163, $@ =~ /^Key 'prefix' not associated with a code reference at/);
-
-}
-
-
-#{
-#    # recursion detection in btree
-#    my %hash ;
-#    unlink $Dfile;
-#    my $dbh = new DB_File::BTREEINFO ;
-#    $dbh->{compare} = sub { $hash{3} = 4 ; length $_[0] } ;
-# 
-# 
-#    my (%h);
-#    ok(164, tie(%hash, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $dbh ) );
-#
-#    eval {	$hash{1} = 2;
-#    		$hash{4} = 5;
-#	 };
-#
-#    ok(165, $@ =~ /^DB_File btree_compare: recursion detected/);
-#    {
-#        no warnings;
-#        untie %hash;
-#    }
-#    unlink $Dfile;
-#}
-ok(164,1);
-ok(165,1);
-
-{
-    # Check that two callbacks don't interact
-    my %hash1 ;
-    my %hash2 ;
-    my $h1_count = 0;
-    my $h2_count = 0;
-    unlink $Dfile, $Dfile2;
-    my $dbh1 = new DB_File::BTREEINFO ;
-    $dbh1->{compare} = sub { ++ $h1_count ; $_[0] cmp $_[1] } ; 
-
-    my $dbh2 = new DB_File::BTREEINFO ;
-    $dbh2->{compare} = sub { ;++ $h2_count ; $_[0] cmp $_[1] } ; 
- 
- 
- 
-    my (%h);
-    ok(166, tie(%hash1, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $dbh1 ) );
-    ok(167, tie(%hash2, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) );
-
-    $hash1{DEFG} = 5;
-    $hash1{XYZ} = 2;
-    $hash1{ABCDE} = 5;
-
-    $hash2{defg} = 5;
-    $hash2{xyz} = 2;
-    $hash2{abcde} = 5;
-
-    ok(168, $h1_count > 0);
-    ok(169, $h1_count == $h2_count);
-
-    ok(170, safeUntie \%hash1);
-    ok(171, safeUntie \%hash2);
-    unlink $Dfile, $Dfile2;
-}
-
-{
-   # Check that DBM Filter can cope with read-only $_
-
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   unlink $Dfile;
-
-   ok(172, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-   $db->filter_fetch_key   (sub { }) ;
-   $db->filter_store_key   (sub { }) ;
-   $db->filter_fetch_value (sub { }) ;
-   $db->filter_store_value (sub { }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   ok(173, $h{"fred"} eq "joe");
-
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
-   ok (174, ! $@);
-
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   $h{"fred"} = "joe" ;
-
-   ok(175, $h{"fred"} eq "joe");
-
-   ok(176, $db->FIRSTKEY() eq "fred") ;
-   
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
-   ok (177, ! $@);
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{
-   # Check low-level API works with filter
-
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my $Dfile = "xxy.db";
-   unlink $Dfile;
-
-   ok(178, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ) );
-
-
-   $db->filter_fetch_key   (sub { $_ = unpack("i", $_) } );
-   $db->filter_store_key   (sub { $_ = pack("i", $_) } );
-   $db->filter_fetch_value (sub { $_ = unpack("i", $_) } );
-   $db->filter_store_value (sub { $_ = pack("i", $_) } );
-
-   $_ = 'fred';
-
-   my $key = 22 ;
-   my $value = 34 ;
-
-   $db->put($key, $value) ;
-   ok 179, $key == 22;
-   ok 180, $value == 34 ;
-   ok 181, $_ eq 'fred';
-   #print "k [$key][$value]\n" ;
-
-   my $val ;
-   $db->get($key, $val) ;
-   ok 182, $key == 22;
-   ok 183, $val == 34 ;
-   ok 184, $_ eq 'fred';
-
-   $key = 51 ;
-   $value = 454;
-   $h{$key} = $value ;
-   ok 185, $key == 51;
-   ok 186, $value == 454 ;
-   ok 187, $_ eq 'fred';
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-
-{
-    # Regression Test for bug 30237
-    # Check that substr can be used in the key to db_put
-    # and that db_put does not trigger the warning
-    # 
-    #     Use of uninitialized value in subroutine entry
-
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-    my $Dfile = "xxy.db";
-    unlink $Dfile;
-
-    ok(188, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE ));
-
-    my $warned = '';
-    local $SIG{__WARN__} = sub {$warned = $_[0]} ;
-
-    # db-put with substr of key
-    my %remember = () ;
-    for my $ix ( 10 .. 12 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $db->put(substr($key,0), $value) ;
-    }
-
-    ok 189, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # db-put with substr of value
-    $warned = '';
-    for my $ix ( 20 .. 22 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $db->put($key, substr($value,0)) ;
-    }
-
-    ok 190, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied hash is not a problem, but check anyway
-    # substr of key
-    $warned = '';
-    for my $ix ( 30 .. 32 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $h{substr($key,0)} = $value ;
-    }
-
-    ok 191, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied hash is not a problem, but check anyway
-    # substr of value
-    $warned = '';
-    for my $ix ( 40 .. 42 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $h{$key} = substr($value,0) ;
-    }
-
-    ok 192, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    my %bad = () ;
-    $key = '';
-    for ($status = $db->seq($key, $value, R_FIRST ) ;
-         $status == 0 ;
-         $status = $db->seq($key, $value, R_NEXT ) ) {
-
-        #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
-             $remember{$key} eq $value) {
-            delete $remember{$key} ;
-        }
-        else {
-            $bad{$key} = $value ;
-        }
-    }
-    
-    ok 193, keys %bad == 0 ;
-    ok 194, keys %remember == 0 ;
-
-    print "# missing -- $key $value\n" while ($key, $value) = each %remember;
-    print "# bad     -- $key $value\n" while ($key, $value) = each %bad;
-
-    # Make sure this fix does not break code to handle an undef key
-    # Berkeley DB undef key is bron between versions 2.3.16 and 
-    my $value = 'fred';
-    $warned = '';
-    $db->put(undef, $value) ;
-    ok 195, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    my $no_NULL = ($DB_File::db_ver >= 2.003016 && $DB_File::db_ver < 3.001) ;
-    print "# db_ver $DB_File::db_ver\n";
-    $value = '' ;
-    $db->get(undef, $value) ;
-    ok 196, $no_NULL || $value eq 'fred' or print "# got [$value]\n" ;
-    ok 197, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}
-exit ;
diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t
deleted file mode 100644
index 4168362531..0000000000
--- a/ext/DB_File/t/db-hash.t
+++ /dev/null
@@ -1,1225 +0,0 @@
-#!./perl 
- 
-use warnings;
-use strict;
-use Config;
- 
-BEGIN {
-    if($ENV{PERL_CORE}) {
-        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
-            print "1..0 # Skip: DB_File was not built\n";
-            exit 0;
-        }
-    }
-}
-
-use DB_File; 
-use Fcntl;
-
-print "1..166\n";
-
-unlink glob "__db.*";
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
- 
-    print "not " unless $result ;
-    print "ok $no\n" ;
-
-    return $result ;
-}
-
-{
-    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_del
-{ 
-    my $file = shift;
-    local $/ = undef;
-    open(CAT,$file) || die "Cannot open $file: $!";
-    my $result = <CAT>;
-    close(CAT);
-    $result = normalise($result) ;
-    unlink $file ;
-    return $result;
-}   
-
-sub normalise
-{
-    my $data = shift ;
-    $data =~ s#\r\n#\n#g 
-        if $^O eq 'cygwin' ;
-    return $data ;
-}
-
-sub safeUntie
-{
-    my $hashref = shift ;
-    my $no_inner = 1;
-    local $SIG{__WARN__} = sub {-- $no_inner } ;
-    untie %$hashref;
-    return $no_inner;
-}
-
-
-my $Dfile = "dbhash.tmp";
-my $Dfile2 = "dbhash2.tmp";
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
-				|| $DB_File::db_ver >= 3.1 );
-
-unlink $Dfile;
-
-umask(0);
-
-# Check the interface to HASHINFO
-
-my $dbh = new DB_File::HASHINFO ;
-
-ok(1, ! defined $dbh->{bsize}) ;
-ok(2, ! defined $dbh->{ffactor}) ;
-ok(3, ! defined $dbh->{nelem}) ;
-ok(4, ! defined $dbh->{cachesize}) ;
-ok(5, ! defined $dbh->{hash}) ;
-ok(6, ! defined $dbh->{lorder}) ;
-
-$dbh->{bsize} = 3000 ;
-ok(7, $dbh->{bsize} == 3000 );
-
-$dbh->{ffactor} = 9000 ;
-ok(8, $dbh->{ffactor} == 9000 );
-
-$dbh->{nelem} = 400 ;
-ok(9, $dbh->{nelem} == 400 );
-
-$dbh->{cachesize} = 65 ;
-ok(10, $dbh->{cachesize} == 65 );
-
-my $some_sub = sub {} ;
-$dbh->{hash} = $some_sub;
-ok(11, $dbh->{hash} eq $some_sub );
-
-$dbh->{lorder} = 1234 ;
-ok(12, $dbh->{lorder} == 1234 );
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(13, $@ =~ /^DB_File::HASHINFO::STORE - Unknown element 'fred' at/ );
-eval 'my $q = $dbh->{fred}' ;
-ok(14, $@ =~ /^DB_File::HASHINFO::FETCH - Unknown element 'fred' at/ );
-
-
-# Now check the interface to HASH
-my ($X, %h);
-ok(15, $X = tie(%h, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-die "Could not tie: $!" unless $X;
-
-my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-
-my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
-
-ok(16, ($mode & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640) ||
-   $noMode{$^O} );
-
-my ($key, $value, $i);
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(17, !$i );
-
-$h{'goner1'} = 'snork';
-
-$h{'abc'} = 'ABC';
-ok(18, $h{'abc'} eq 'ABC' );
-ok(19, !defined $h{'jimmy'} );
-ok(20, !exists $h{'jimmy'} );
-ok(21, exists $h{'abc'} );
-
-$h{'def'} = 'DEF';
-$h{'jkl','mno'} = "JKL\034MNO";
-$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
-$h{'a'} = 'A';
-
-#$h{'b'} = 'B';
-$X->STORE('b', 'B') ;
-
-$h{'c'} = 'C';
-
-#$h{'d'} = 'D';
-$X->put('d', 'D') ;
-
-$h{'e'} = 'E';
-$h{'f'} = 'F';
-$h{'g'} = 'X';
-$h{'h'} = 'H';
-$h{'i'} = 'I';
-
-$h{'goner2'} = 'snork';
-delete $h{'goner2'};
-
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-untie(%h);
-
-
-# tie to the same file again, do not supply a type - should default to HASH
-ok(22, $X = tie(%h,'DB_File',$Dfile, O_RDWR, 0640) );
-
-# Modify an entry from the previous tie
-$h{'g'} = 'G';
-
-$h{'j'} = 'J';
-$h{'k'} = 'K';
-$h{'l'} = 'L';
-$h{'m'} = 'M';
-$h{'n'} = 'N';
-$h{'o'} = 'O';
-$h{'p'} = 'P';
-$h{'q'} = 'Q';
-$h{'r'} = 'R';
-$h{'s'} = 'S';
-$h{'t'} = 'T';
-$h{'u'} = 'U';
-$h{'v'} = 'V';
-$h{'w'} = 'W';
-$h{'x'} = 'X';
-$h{'y'} = 'Y';
-$h{'z'} = 'Z';
-
-$h{'goner3'} = 'snork';
-
-delete $h{'goner1'};
-$X->DELETE('goner3');
-
-my @keys = keys(%h);
-my @values = values(%h);
-
-ok(23, $#keys == 29 && $#values == 29) ;
-
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    if ($key eq $keys[$i] && $value eq $values[$i] && $key eq lc($value)) {
-	$key =~ y/a-z/A-Z/;
-	$i++ if $key eq $value;
-    }
-}
-
-ok(24, $i == 30) ;
-
-@keys = ('blurfl', keys(%h), 'dyick');
-ok(25, $#keys == 31) ;
-
-$h{'foo'} = '';
-ok(26, $h{'foo'} eq '' );
-
-# Berkeley DB from version 2.4.10 to 3.0 does not allow null keys.
-# This feature was reenabled in version 3.1 of Berkeley DB.
-my $result = 0 ;
-if ($null_keys_allowed) {
-    $h{''} = 'bar';
-    $result = ( $h{''} eq 'bar' );
-}
-else
-  { $result = 1 }
-ok(27, $result) ;
-
-# check cache overflow and numeric keys and contents
-my $ok = 1;
-for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
-for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
-ok(28, $ok );
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
-   $blksize,$blocks) = stat($Dfile);
-ok(29, $size > 0 );
-
-@h{0..200} = 200..400;
-my @foo = @h{0..200};
-ok(30, join(':',200..400) eq join(':',@foo) );
-
-
-# Now check all the non-tie specific stuff
-
-# Check NOOVERWRITE will make put fail when attempting to overwrite
-# an existing record.
- 
-my $status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ;
-ok(31, $status == 1 );
- 
-# check that the value of the key 'x' has not been changed by the 
-# previous test
-ok(32, $h{'x'} eq 'X' );
-
-# standard put
-$status = $X->put('key', 'value') ;
-ok(33, $status == 0 );
-
-#check that previous put can be retrieved
-$value = 0 ;
-$status = $X->get('key', $value) ;
-ok(34, $status == 0 );
-ok(35, $value eq 'value' );
-
-# Attempting to delete an existing key should work
-
-$status = $X->del('q') ;
-ok(36, $status == 0 );
-
-# Make sure that the key deleted, cannot be retrieved
-{
-    no warnings 'uninitialized' ;
-    ok(37, $h{'q'} eq undef );
-}
-
-# Attempting to delete a non-existant key should fail
-
-$status = $X->del('joe') ;
-ok(38, $status == 1 );
-
-# Check the get interface
-
-# First a non-existing key
-$status = $X->get('aaaa', $value) ;
-ok(39, $status == 1 );
-
-# Next an existing key
-$status = $X->get('a', $value) ;
-ok(40, $status == 0 );
-ok(41, $value eq 'A' );
-
-# seq
-# ###
-
-# ditto, but use put to replace the key/value pair.
-
-# use seq to walk backwards through a file - check that this reversed is
-
-# check seq FIRST/LAST
-
-# sync
-# ####
-
-$status = $X->sync ;
-ok(42, $status == 0 );
-
-
-# fd
-# ##
-
-$status = $X->fd ;
-ok(43, 1 );
-#ok(43, $status != 0 );
-
-undef $X ;
-untie %h ;
-
-unlink $Dfile;
-
-# clear
-# #####
-
-ok(44, tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-foreach (1 .. 10)
-  { $h{$_} = $_ * 100 }
-
-# check that there are 10 elements in the hash
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(45, $i == 10);
-
-# now clear the hash
-%h = () ;
-
-# check it is empty
-$i = 0 ;
-while (($key,$value) = each(%h)) {
-    $i++;
-}
-ok(46, $i == 0);
-
-untie %h ;
-unlink $Dfile ;
-
-
-# Now try an in memory file
-ok(47, $X = tie(%h, 'DB_File',undef, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-# fd with an in memory file should return fail
-$status = $X->fd ;
-ok(48, $status == -1 );
-
-undef $X ;
-untie %h ;
-
-{
-    # check ability to override the default hashing
-    my %x ;
-    my $filename = "xyz" ;
-    my $hi = new DB_File::HASHINFO ;
-    $::count = 0 ;
-    $hi->{hash} = sub { ++$::count ; length $_[0] } ;
-    ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
-    $h{"abc"} = 123 ;
-    ok(50, $h{"abc"} == 123) ;
-    untie %x ;
-    unlink $filename ;
-    ok(51, $::count >0) ;
-}
-
-{
-    # check that attempting to tie an array to a DB_HASH will fail
-
-    my $filename = "xyz" ;
-    my @x ;
-    eval { tie @x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_HASH ; } ;
-    ok(52, $@ =~ /^DB_File can only tie an associative array to a DB_HASH database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   our (@ISA, @EXPORT);
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-	my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-	my $self = shift ;
-        $self->SUPER::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(53, $@ eq "") ;
-    my %h ;
-    my $X ;
-    eval '
-	$X = tie(%h, "SubDB","dbhash.tmp", O_RDWR|O_CREAT, 0640, $DB_HASH );
-	' ;
-
-    main::ok(54, $@ eq "") ;
-
-    my $ret = eval '$h{"fred"} = 3 ; return $h{"fred"} ' ;
-    main::ok(55, $@ eq "") ;
-    main::ok(56, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put("joe", 4) ; $X->get("joe", $value) ; return $value' ;
-    main::ok(57, $@ eq "") ;
-    main::ok(58, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(59, $@ eq "" ) ;
-    main::ok(60, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method("joe") ' ;
-    main::ok(61, $@ eq "") ;
-    main::ok(62, $ret eq "[[11]]") ;
-
-    undef $X;
-    untie(%h);
-    unlink "SubDB.pm", "dbhash.tmp" ;
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   unlink $Dfile;
-
-   sub checkOutput
-   {
-       no warnings 'uninitialized';
-       my($fk, $sk, $fv, $sv) = @_ ;
-
-       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n" 
-           if $fetch_key ne $fk ;
-       print "# Fetch Value : expected '$fv' got '$fetch_value'\n" 
-           if $fetch_value ne $fv ;
-       print "# Store Key   : expected '$sk' got '$store_key'\n" 
-           if $store_key ne $sk ;
-       print "# Store Value : expected '$sv' got '$store_value'\n" 
-           if $store_value ne $sv ;
-       print "# \$_          : expected 'original' got '$_'\n" 
-           if $_ ne 'original' ;
-
-       return
-           $fetch_key   eq $fk && $store_key   eq $sk && 
-	   $fetch_value eq $fv && $store_value eq $sv &&
-	   $_ eq 'original' ;
-   }
-   
-   ok(63, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-   $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(64, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(65, $h{"fred"} eq "joe");
-   #                   fk    sk     fv    sv
-   ok(66, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   my ($k, $v) ;
-   $k = 'fred';
-   ok(67, ! $db->seq($k, $v, R_FIRST) ) ;
-   ok(68, $k eq "fred") ;
-   ok(69, $v eq "joe") ;
-   #                    fk     sk  fv  sv
-   ok(70, checkOutput( "fred", "fred", "joe", "")) ;
-
-   # 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(71, checkOutput( "", "fred", "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(72, $h{"Fred"} eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(73, checkOutput( "", "fred", "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $k = 'Fred'; $v ='';
-   ok(74, ! $db->seq($k, $v, R_FIRST) ) ;
-   ok(75, $k eq "FRED") or 
-    print "# k [$k]\n" ;
-   ok(76, $v eq "[Jxe]") ;
-   #                   fk   sk     fv    sv
-   ok(77, checkOutput( "FRED", "fred", "[Jxe]", "")) ;
-
-   # 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(78, checkOutput( "", "fred", "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(79, $h{"fred"} eq "joe");
-   ok(80, checkOutput( "", "fred", "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   #ok(77, $db->FIRSTKEY() eq "fred") ;
-   $k = 'fred';
-   ok(81, ! $db->seq($k, $v, R_FIRST) ) ;
-   ok(82, $k eq "fred") ;
-   ok(83, $v eq "joe") ;
-   #                   fk   sk     fv    sv
-   ok(84, checkOutput( "fred", "fred", "joe", "")) ;
-
-   # 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(85, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(86, $h{"fred"} eq "joe");
-   ok(87, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   $k = 'fred';
-   ok(88, ! $db->seq($k, $v, R_FIRST) ) ;
-   ok(89, $k eq "fred") ;
-   ok(90, $v eq "joe") ;
-   ok(91, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-
-    unlink $Dfile;
-    ok(92, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-    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(93, $result{"store key"} eq "store key - 1: [fred]");
-    ok(94, $result{"store value"} eq "store value - 1: [joe]");
-    ok(95, ! defined $result{"fetch key"} );
-    ok(96, ! defined $result{"fetch value"} );
-    ok(97, $_ eq "original") ;
-
-    ok(98, $db->FIRSTKEY() eq "fred") ;
-    ok(99, $result{"store key"} eq "store key - 1: [fred]");
-    ok(100, $result{"store value"} eq "store value - 1: [joe]");
-    ok(101, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(102, ! defined $result{"fetch value"} );
-    ok(103, $_ eq "original") ;
-
-    $h{"jim"}  = "john" ;
-    ok(104, $result{"store key"} eq "store key - 2: [fred jim]");
-    ok(105, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(106, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(107, ! defined $result{"fetch value"} );
-    ok(108, $_ eq "original") ;
-
-    ok(109, $h{"fred"} eq "joe");
-    ok(110, $result{"store key"} eq "store key - 3: [fred jim fred]");
-    ok(111, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(112, $result{"fetch key"} eq "fetch key - 1: [fred]");
-    ok(113, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(114, $_ eq "original") ;
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}		
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   unlink $Dfile;
-
-   ok(115, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-   $db->filter_store_key (sub { $_ = $h{$_} }) ;
-
-   eval '$h{1} = 1234' ;
-   ok(116, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    use DB_File ;
-    our (%h, $k, $v);
-
-    unlink "fruit" ;
-    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
-        or die "Cannot open file 'fruit': $!\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 "fruit" ;
-  }  
-
-  ok(117, docat_del($file) eq <<'EOM') ;
-Banana Exists
-
-orange -> orange
-tomato -> red
-banana -> yellow
-EOM
-   
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
-    $h{ABC} = undef;
-    ok(118, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my %h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie %h, 'DB_File', $Dfile or die "Can't open file: $!\n" ;
-    %h = (); ;
-    ok(119, $a eq "") ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # When iterating over a tied hash using "each", the key passed to FETCH
-    # will be recycled and passed to NEXTKEY. If a Source Filter modifies the
-    # key in FETCH via a filter_fetch_key method we need to check that the
-    # modified key doesn't get passed to NEXTKEY.
-    # Also Test "keys" & "values" while we are at it.
-
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my $bad_key = 0 ;
-    my %h = () ;
-    my $db ;
-    ok(120, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-    $db->filter_fetch_key (sub { $_ =~ s/^Beta_/Alpha_/ if defined $_}) ;
-    $db->filter_store_key (sub { $bad_key = 1 if /^Beta_/ ; $_ =~ s/^Alpha_/Beta_/}) ;
-
-    $h{'Alpha_ABC'} = 2 ;
-    $h{'Alpha_DEF'} = 5 ;
-
-    ok(121, $h{'Alpha_ABC'} == 2);
-    ok(122, $h{'Alpha_DEF'} == 5);
-
-    my ($k, $v) = ("","");
-    while (($k, $v) = each %h) {}
-    ok(123, $bad_key == 0);
-
-    $bad_key = 0 ;
-    foreach $k (keys %h) {}
-    ok(124, $bad_key == 0);
-
-    $bad_key = 0 ;
-    foreach $v (values %h) {}
-    ok(125, $bad_key == 0);
-
-    undef $db ;
-    untie %h ;
-    unlink $Dfile;
-}
-
-{
-    # now an error to pass 'hash' a non-code reference
-    my $dbh = new DB_File::HASHINFO ;
-
-    eval { $dbh->{hash} = 2 };
-    ok(126, $@ =~ /^Key 'hash' not associated with a code reference at/);
-
-}
-
-
-#{
-#    # recursion detection in hash
-#    my %hash ;
-#    my $Dfile = "xxx.db";
-#    unlink $Dfile;
-#    my $dbh = new DB_File::HASHINFO ;
-#    $dbh->{hash} = sub { $hash{3} = 4 ; length $_[0] } ;
-# 
-# 
-#    ok(127, tie(%hash, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $dbh ) );
-#
-#    eval {	$hash{1} = 2;
-#    		$hash{4} = 5;
-#	 };
-#
-#    ok(128, $@ =~ /^DB_File hash callback: recursion detected/);
-#    {
-#        no warnings;
-#        untie %hash;
-#    }
-#    unlink $Dfile;
-#}
-
-#ok(127, 1);
-#ok(128, 1);
-
-{
-    # Check that two hash's don't interact
-    my %hash1 ;
-    my %hash2 ;
-    my $h1_count = 0;
-    my $h2_count = 0;
-    unlink $Dfile, $Dfile2;
-    my $dbh1 = new DB_File::HASHINFO ;
-    $dbh1->{hash} = sub { ++ $h1_count ; length $_[0] } ;
-
-    my $dbh2 = new DB_File::HASHINFO ;
-    $dbh2->{hash} = sub { ++ $h2_count ; length $_[0] } ;
- 
- 
- 
-    my (%h);
-    ok(127, tie(%hash1, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $dbh1 ) );
-    ok(128, tie(%hash2, 'DB_File',$Dfile2, O_RDWR|O_CREAT, 0640, $dbh2 ) );
-
-    $hash1{DEFG} = 5;
-    $hash1{XYZ} = 2;
-    $hash1{ABCDE} = 5;
-
-    $hash2{defg} = 5;
-    $hash2{xyz} = 2;
-    $hash2{abcde} = 5;
-
-    ok(129, $h1_count > 0);
-    ok(130, $h1_count == $h2_count);
-
-    ok(131, safeUntie \%hash1);
-    ok(132, safeUntie \%hash2);
-    unlink $Dfile, $Dfile2;
-}
-
-{
-    # Passing undef for flags and/or mode when calling tie could cause 
-    #     Use of uninitialized value in subroutine entry
-    
-
-    my $warn_count = 0 ;
-    #local $SIG{__WARN__} = sub { ++ $warn_count };
-    my %hash1;
-    unlink $Dfile;
-
-    tie %hash1, 'DB_File',$Dfile, undef;
-    ok(133, $warn_count == 0);
-    $warn_count = 0;
-    untie %hash1;
-    unlink $Dfile;
-    tie %hash1, 'DB_File',$Dfile, O_RDWR|O_CREAT, undef;
-    ok(134, $warn_count == 0);
-    untie %hash1;
-    unlink $Dfile;
-    tie %hash1, 'DB_File',$Dfile, undef, undef;
-    ok(135, $warn_count == 0);
-    $warn_count = 0;
-
-    untie %hash1;
-    unlink $Dfile;
-}
-
-{
-   # Check that DBM Filter can cope with read-only $_
-
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my $Dfile = "xxy.db";
-   unlink $Dfile;
-
-   ok(136, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-   $db->filter_fetch_key   (sub { }) ;
-   $db->filter_store_key   (sub { }) ;
-   $db->filter_fetch_value (sub { }) ;
-   $db->filter_store_value (sub { }) ;
-
-   $_ = "original" ;
-
-   $h{"fred"} = "joe" ;
-   ok(137, $h{"fred"} eq "joe");
-
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
-   ok (138, ! $@);
-
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   $h{"fred"} = "joe" ;
-
-   ok(139, $h{"fred"} eq "joe");
-
-   ok(140, $db->FIRSTKEY() eq "fred") ;
-   
-   eval { my @r= grep { $h{$_} } (1, 2, 3) };
-   ok (141, ! $@);
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-{
-   # Check low-level API works with filter
-
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my $Dfile = "xxy.db";
-   unlink $Dfile;
-
-   ok(142, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-
-   $db->filter_fetch_key   (sub { $_ = unpack("i", $_) } );
-   $db->filter_store_key   (sub { $_ = pack("i", $_) } );
-   $db->filter_fetch_value (sub { $_ = unpack("i", $_) } );
-   $db->filter_store_value (sub { $_ = pack("i", $_) } );
-
-   $_ = 'fred';
-
-   my $key = 22 ;
-   my $value = 34 ;
-
-   $db->put($key, $value) ;
-   ok 143, $key == 22;
-   ok 144, $value == 34 ;
-   ok 145, $_ eq 'fred';
-   #print "k [$key][$value]\n" ;
-
-   my $val ;
-   $db->get($key, $val) ;
-   ok 146, $key == 22;
-   ok 147, $val == 34 ;
-   ok 148, $_ eq 'fred';
-
-   $key = 51 ;
-   $value = 454;
-   $h{$key} = $value ;
-   ok 149, $key == 51;
-   ok 150, $value == 454 ;
-   ok 151, $_ eq 'fred';
-
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-
-{
-    # Regression Test for bug 30237
-    # Check that substr can be used in the key to db_put
-    # and that db_put does not trigger the warning
-    # 
-    #     Use of uninitialized value in subroutine entry
-
-
-    use warnings ;
-    use strict ;
-    my (%h, $db) ;
-    my $Dfile = "xxy.db";
-    unlink $Dfile;
-
-    ok(152, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-    my $warned = '';
-    local $SIG{__WARN__} = sub {$warned = $_[0]} ;
-
-    # db-put with substr of key
-    my %remember = () ;
-    for my $ix ( 1 .. 2 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $db->put(substr($key,0), $value) ;
-    }
-
-    ok 153, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # db-put with substr of value
-    $warned = '';
-    for my $ix ( 10 .. 12 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $db->put($key, substr($value,0)) ;
-    }
-
-    ok 154, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied hash is not a problem, but check anyway
-    # substr of key
-    $warned = '';
-    for my $ix ( 30 .. 32 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $h{substr($key,0)} = $value ;
-    }
-
-    ok 155, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied hash is not a problem, but check anyway
-    # substr of value
-    $warned = '';
-    for my $ix ( 40 .. 42 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $h{$key} = substr($value,0) ;
-    }
-
-    ok 156, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    my %bad = () ;
-    $key = '';
-    for ($status = $db->seq(substr($key,0), substr($value,0), R_FIRST ) ;
-         $status == 0 ;
-         $status = $db->seq(substr($key,0), substr($value,0), R_NEXT ) ) {
-
-        #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
-             $remember{$key} eq $value) {
-            delete $remember{$key} ;
-        }
-        else {
-            $bad{$key} = $value ;
-        }
-    }
-    
-    ok 157, keys %bad == 0 ;
-    ok 158, keys %remember == 0 ;
-
-    print "# missing -- $key=>$value\n" while ($key, $value) = each %remember;
-    print "# bad     -- $key=>$value\n" while ($key, $value) = each %bad;
-
-    # Make sure this fix does not break code to handle an undef key
-    # Berkeley DB undef key is broken between versions 2.3.16 and 3.1
-    my $value = 'fred';
-    $warned = '';
-    $db->put(undef, $value) ;
-    ok 159, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    my $no_NULL = ($DB_File::db_ver >= 2.003016 && $DB_File::db_ver < 3.001) ;
-    print "# db_ver $DB_File::db_ver\n";
-    $value = '' ;
-    $db->get(undef, $value) ;
-    ok 160, $no_NULL || $value eq 'fred' or print "# got [$value]\n" ;
-    ok 161, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    undef $db ;
-    untie %h;
-    unlink $Dfile;
-}
-
-{
-   # Check filter + substr
-
-   use warnings ;
-   use strict ;
-   my (%h, $db) ;
-   my $Dfile = "xxy.db";
-   unlink $Dfile;
-
-   ok(162, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
-
-
-   {
-       $db->filter_fetch_key   (sub { lc $_ } );
-       $db->filter_store_key   (sub { uc $_ } );
-       $db->filter_fetch_value (sub { lc $_ } );
-       $db->filter_store_value (sub { uc $_ } );
-   }
-
-   $_ = 'fred';
-
-    # db-put with substr of key
-    my %remember = () ;
-    my $status = 0 ;
-    for my $ix ( 1 .. 2 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$key} = $value ;
-        $status += $db->put(substr($key,0), substr($value,0)) ;
-    }
-
-    ok 163, $status == 0 or print "# Status $status\n" ;
-
-    if (1)
-    {
-       $db->filter_fetch_key   (undef);
-       $db->filter_store_key   (undef);
-       $db->filter_fetch_value (undef);
-       $db->filter_store_value (undef);
-    }
-
-    my %bad = () ;
-    my $key = '';
-    my $value = '';
-    for ($status = $db->seq($key, $value, R_FIRST ) ;
-         $status == 0 ;
-         $status = $db->seq($key, $value, R_NEXT ) ) {
-
-        #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
-             $remember{$key} eq $value) {
-            delete $remember{$key} ;
-        }
-        else {
-            $bad{$key} = $value ;
-        }
-    }
-    
-    ok 164, $_ eq 'fred';
-    ok 165, keys %bad == 0 ;
-    ok 166, keys %remember == 0 ;
-
-    print "# missing -- $key $value\n" while ($key, $value) = each %remember;
-    print "# bad     -- $key $value\n" while ($key, $value) = each %bad;
-   undef $db ;
-   untie %h;
-   unlink $Dfile;
-}
-
-exit ;
diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
deleted file mode 100644
index 365abfd520..0000000000
--- a/ext/DB_File/t/db-recno.t
+++ /dev/null
@@ -1,1596 +0,0 @@
-#!./perl -w
- 
-use warnings;
-use strict;
-use Config;
- 
-BEGIN {
-    if($ENV{PERL_CORE}) {
-        if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
-            print "1..0 # Skip: DB_File was not built\n";
-            exit 0;
-        }
-    }
-}
-
-use DB_File; 
-use Fcntl;
-our ($dbh, $Dfile, $bad_ones, $FA);
-
-# full tied array support started in Perl 5.004_57
-# Double check to see if it is available.
-
-{
-    sub try::TIEARRAY { bless [], "try" }
-    sub try::FETCHSIZE { $FA = 1 }
-    $FA = 0 ;
-    my @a ; 
-    tie @a, 'try' ;
-    my $a = @a ;
-}
-
-
-sub ok
-{
-    my $no = shift ;
-    my $result = shift ;
-
-    print "not " unless $result ;
-    print "ok $no\n" ;
-
-    return $result ;
-}
-
-{
-    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);
-    normalise($result) ;
-    return $result;
-}
-
-sub docat_del
-{ 
-    my $file = shift;
-    my $result = docat($file);
-    unlink $file ;
-    return $result;
-}   
-
-sub safeUntie
-{
-    my $hashref = shift ;
-    my $no_inner = 1;
-    local $SIG{__WARN__} = sub {-- $no_inner } ;
-    untie @$hashref;
-    return $no_inner;
-}
-
-sub bad_one
-{
-    unless ($bad_ones++) {
-	print STDERR <<EOM ;
-#
-# Some older versions of Berkeley DB version 1 will fail db-recno
-# tests 61, 63, 64 and 65.
-EOM
-        if ($^O eq 'darwin'
-	    && $Config{db_version_major} == 1
-	    && $Config{db_version_minor} == 0
-	    && $Config{db_version_patch} == 0) {
-	    print STDERR <<EOM ;
-#
-# For example Mac OS X 10.2 (or earlier) has such an old
-# version of Berkeley DB.
-EOM
-	}
-
-	print STDERR <<EOM ;
-#
-# You can safely ignore the errors if you're never going to use the
-# broken functionality (recno databases with a modified bval). 
-# Otherwise you'll have to upgrade your DB library.
-#
-# If you want to use Berkeley DB version 1, then 1.85 and 1.86 are the
-# last versions that were released. Berkeley DB version 2 is continually
-# being updated -- Check out http://www.sleepycat.com/ for more details.
-#
-EOM
-    }
-}
-
-sub normalise
-{
-    return unless $^O eq 'cygwin' ;
-    foreach (@_)
-      { s#\r\n#\n#g }     
-}
-
-BEGIN 
-{ 
-    { 
-        local $SIG{__DIE__} ; 
-        eval { require Data::Dumper ; import Data::Dumper } ; 
-    }
- 
-    if ($@) {
-        *Dumper = sub { my $a = shift; return "[ @{ $a } ]" } ;
-    }          
-}
-
-my $splice_tests = 10 + 12 + 1; # ten regressions, plus the randoms
-my $total_tests = 181 ;
-$total_tests += $splice_tests if $FA ;
-print "1..$total_tests\n";   
-
-$Dfile = "recno.tmp";
-unlink $Dfile ;
-
-umask(0);
-
-# Check the interface to RECNOINFO
-
-$dbh = new DB_File::RECNOINFO ;
-ok(1, ! defined $dbh->{bval}) ;
-ok(2, ! defined $dbh->{cachesize}) ;
-ok(3, ! defined $dbh->{psize}) ;
-ok(4, ! defined $dbh->{flags}) ;
-ok(5, ! defined $dbh->{lorder}) ;
-ok(6, ! defined $dbh->{reclen}) ;
-ok(7, ! defined $dbh->{bfname}) ;
-
-$dbh->{bval} = 3000 ;
-ok(8, $dbh->{bval} == 3000 );
-
-$dbh->{cachesize} = 9000 ;
-ok(9, $dbh->{cachesize} == 9000 );
-
-$dbh->{psize} = 400 ;
-ok(10, $dbh->{psize} == 400 );
-
-$dbh->{flags} = 65 ;
-ok(11, $dbh->{flags} == 65 );
-
-$dbh->{lorder} = 123 ;
-ok(12, $dbh->{lorder} == 123 );
-
-$dbh->{reclen} = 1234 ;
-ok(13, $dbh->{reclen} == 1234 );
-
-$dbh->{bfname} = 1234 ;
-ok(14, $dbh->{bfname} == 1234 );
-
-
-# Check that an invalid entry is caught both for store & fetch
-eval '$dbh->{fred} = 1234' ;
-ok(15, $@ =~ /^DB_File::RECNOINFO::STORE - Unknown element 'fred' at/ );
-eval 'my $q = $dbh->{fred}' ;
-ok(16, $@ =~ /^DB_File::RECNOINFO::FETCH - Unknown element 'fred' at/ );
-
-# Now check the interface to RECNOINFO
-
-my $X  ;
-my @h ;
-ok(17, $X = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
-
-my %noMode = map { $_, 1} qw( amigaos MSWin32 NetWare cygwin ) ;
-
-ok(18, ((stat($Dfile))[2] & 0777) == (($^O eq 'os2' || $^O eq 'MacOS') ? 0666 : 0640)
-	||  $noMode{$^O} );
-
-#my $l = @h ;
-my $l = $X->length ;
-ok(19, ($FA ? @h == 0 : !$l) );
-
-my @data = qw( a b c d ever f g h  i j k longername m n o p) ;
-
-$h[0] = shift @data ;
-ok(20, $h[0] eq 'a' );
-
-my $ i;
-foreach (@data)
-  { $h[++$i] = $_ }
-
-unshift (@data, 'a') ;
-
-ok(21, defined $h[1] );
-ok(22, ! defined $h[16] );
-ok(23, $FA ? @h == @data : $X->length == @data );
-
-
-# Overwrite an entry & check fetch it
-$h[3] = 'replaced' ;
-$data[3] = 'replaced' ;
-ok(24, $h[3] eq 'replaced' );
-
-#PUSH
-my @push_data = qw(added to the end) ;
-($FA ? push(@h, @push_data) : $X->push(@push_data)) ;
-push (@data, @push_data) ;
-ok(25, $h[++$i] eq 'added' );
-ok(26, $h[++$i] eq 'to' );
-ok(27, $h[++$i] eq 'the' );
-ok(28, $h[++$i] eq 'end' );
-
-# POP
-my $popped = pop (@data) ;
-my $value = ($FA ? pop @h : $X->pop) ;
-ok(29, $value eq $popped) ;
-
-# SHIFT
-$value = ($FA ? shift @h : $X->shift) ;
-my $shifted = shift @data ;
-ok(30, $value eq $shifted );
-
-# UNSHIFT
-
-# empty list
-($FA ? unshift @h,() : $X->unshift) ;
-ok(31, ($FA ? @h == @data : $X->length == @data ));
-
-my @new_data = qw(add this to the start of the array) ;
-$FA ? unshift (@h, @new_data) : $X->unshift (@new_data) ;
-unshift (@data, @new_data) ;
-ok(32, $FA ? @h == @data : $X->length == @data );
-ok(33, $h[0] eq "add") ;
-ok(34, $h[1] eq "this") ;
-ok(35, $h[2] eq "to") ;
-ok(36, $h[3] eq "the") ;
-ok(37, $h[4] eq "start") ;
-ok(38, $h[5] eq "of") ;
-ok(39, $h[6] eq "the") ;
-ok(40, $h[7] eq "array") ;
-ok(41, $h[8] eq $data[8]) ;
-
-# Brief test for SPLICE - more thorough 'soak test' is later.
-my @old;
-if ($FA) {
-    @old = splice(@h, 1, 2, qw(bananas just before));
-}
-else {
-    @old = $X->splice(1, 2, qw(bananas just before));
-}
-ok(42, $h[0] eq "add") ;
-ok(43, $h[1] eq "bananas") ;
-ok(44, $h[2] eq "just") ;
-ok(45, $h[3] eq "before") ;
-ok(46, $h[4] eq "the") ;
-ok(47, $h[5] eq "start") ;
-ok(48, $h[6] eq "of") ;
-ok(49, $h[7] eq "the") ;
-ok(50, $h[8] eq "array") ;
-ok(51, $h[9] eq $data[8]) ;
-$FA ? splice(@h, 1, 3, @old) : $X->splice(1, 3, @old);
-
-# Now both arrays should be identical
-
-my $ok = 1 ;
-my $j = 0 ;
-foreach (@data)
-{
-   $ok = 0, last if $_ ne $h[$j ++] ; 
-}
-ok(52, $ok );
-
-# Neagtive subscripts
-
-# get the last element of the array
-ok(53, $h[-1] eq $data[-1] );
-ok(54, $h[-1] eq $h[ ($FA ? @h : $X->length) -1] );
-
-# get the first element using a negative subscript
-eval '$h[ - ( $FA ? @h : $X->length)] = "abcd"' ;
-ok(55, $@ eq "" );
-ok(56, $h[0] eq "abcd" );
-
-# now try to read before the start of the array
-eval '$h[ - (1 + ($FA ? @h : $X->length))] = 1234' ;
-ok(57, $@ =~ '^Modification of non-creatable array value attempted' );
-
-# IMPORTANT - $X must be undefined before the untie otherwise the
-#             underlying DB close routine will not get called.
-undef $X ;
-ok(58, safeUntie \@h);
-
-unlink $Dfile;
-
-
-{
-    # Check bval defaults to \n
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    ok(59, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    ok(60, safeUntie \@h);
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    ok(61, $x eq "abc\ndef\n\nghi\n") ;
-}
-
-{
-    # Change bval
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{bval} = "-" ;
-    ok(62, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    ok(63, safeUntie \@h);
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc-def--ghi-") ;
-    bad_one() unless $ok ;
-    ok(64, $ok) ;
-}
-
-{
-    # Check R_FIXEDLEN with default bval (space)
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{flags} = R_FIXEDLEN ;
-    $dbh->{reclen} = 5 ;
-    ok(65, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    ok(66, safeUntie \@h);
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc  def       ghi  ") ;
-    bad_one() unless $ok ;
-    ok(67, $ok) ;
-}
-
-{
-    # Check R_FIXEDLEN with user-defined bval
-
-    my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
-    $dbh->{flags} = R_FIXEDLEN ;
-    $dbh->{bval} = "-" ;
-    $dbh->{reclen} = 5 ;
-    ok(68, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[3] = "ghi" ;
-    ok(69, safeUntie \@h);
-    my $x = docat($Dfile) ;
-    unlink $Dfile;
-    my $ok = ($x eq "abc--def-------ghi--") ;
-    bad_one() unless $ok ;
-    ok(70, $ok) ;
-}
-
-{
-    # check that attempting to tie an associative array to a DB_RECNO will fail
-
-    my $filename = "xyz" ;
-    my %x ;
-    eval { tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO ; } ;
-    ok(71, $@ =~ /^DB_File can only tie an array to a DB_RECNO database/) ;
-    unlink $filename ;
-}
-
-{
-   # sub-class test
-
-   package Another ;
-
-   use warnings ;
-   use strict ;
-
-   open(FILE, ">SubDB.pm") or die "Cannot open SubDB.pm: $!\n" ;
-   print FILE <<'EOM' ;
-
-   package SubDB ;
-
-   use warnings ;
-   use strict ;
-   our (@ISA, @EXPORT);
-
-   require Exporter ;
-   use DB_File;
-   @ISA=qw(DB_File);
-   @EXPORT = @DB_File::EXPORT ;
-
-   sub STORE { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::STORE($key, $value * 2) ;
-   }
-
-   sub FETCH { 
-	my $self = shift ;
-        my $key = shift ;
-        $self->SUPER::FETCH($key) - 1 ;
-   }
-
-   sub put { 
-	my $self = shift ;
-        my $key = shift ;
-        my $value = shift ;
-        $self->SUPER::put($key, $value * 3) ;
-   }
-
-   sub get { 
-	my $self = shift ;
-        $self->SUPER::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  or die "Could not close: $!";
-
-    BEGIN { push @INC, '.'; } 
-    eval 'use SubDB ; ';
-    main::ok(72, $@ eq "") ;
-    my @h ;
-    my $X ;
-    eval '
-	$X = tie(@h, "SubDB","recno.tmp", O_RDWR|O_CREAT, 0640, $DB_RECNO );
-	' ;
-    die "Could not tie: $!" unless $X;
-
-    main::ok(73, $@ eq "") ;
-
-    my $ret = eval '$h[3] = 3 ; return $h[3] ' ;
-    main::ok(74, $@ eq "") ;
-    main::ok(75, $ret == 5) ;
-
-    my $value = 0;
-    $ret = eval '$X->put(1, 4) ; $X->get(1, $value) ; return $value' ;
-    main::ok(76, $@ eq "") ;
-    main::ok(77, $ret == 10) ;
-
-    $ret = eval ' R_NEXT eq main::R_NEXT ' ;
-    main::ok(78, $@ eq "" ) ;
-    main::ok(79, $ret == 1) ;
-
-    $ret = eval '$X->A_new_method(1) ' ;
-    main::ok(80, $@ eq "") ;
-    main::ok(81, $ret eq "[[11]]") ;
-
-    undef $X;
-    main::ok(82, main::safeUntie \@h);
-    unlink "SubDB.pm", "recno.tmp" ;
-
-}
-
-{
-
-    # test $#
-    my $self ;
-    unlink $Dfile;
-    ok(83, $self = tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) ;
-    $h[0] = "abc" ;
-    $h[1] = "def" ;
-    $h[2] = "ghi" ;
-    $h[3] = "jkl" ;
-    ok(84, $FA ? $#h == 3 : $self->length() == 4) ;
-    undef $self ;
-    ok(85, safeUntie \@h);
-    my $x = docat($Dfile) ;
-    ok(86, $x eq "abc\ndef\nghi\njkl\n") ;
-
-    # $# sets array to same length
-    $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ;
-    ok(87, $self) 
-        or warn "# $DB_File::Error\n";
-    if ($FA)
-      { $#h = 3 }
-    else 
-      { $self->STORESIZE(4) }
-    ok(88, $FA ? $#h == 3 : $self->length() == 4) ;
-    undef $self ;
-    ok(89, safeUntie \@h);
-    $x = docat($Dfile) ;
-    ok(90, $x eq "abc\ndef\nghi\njkl\n") ;
-
-    # $# sets array to bigger
-    ok(91, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
-    if ($FA)
-      { $#h = 6 }
-    else 
-      { $self->STORESIZE(7) }
-    ok(92, $FA ? $#h == 6 : $self->length() == 7) ;
-    undef $self ;
-    ok(93, safeUntie \@h);
-    $x = docat($Dfile) ;
-    ok(94, $x eq "abc\ndef\nghi\njkl\n\n\n\n") ;
-
-    # $# sets array smaller
-    ok(95, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
-    if ($FA)
-      { $#h = 2 }
-    else 
-      { $self->STORESIZE(3) }
-    ok(96, $FA ? $#h == 2 : $self->length() == 3) ;
-    undef $self ;
-    ok(97, safeUntie \@h);
-    $x = docat($Dfile) ;
-    ok(98, $x eq "abc\ndef\nghi\n") ;
-
-    unlink $Dfile;
-
-
-}
-
-{
-   # DBM Filter tests
-   use warnings ;
-   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) = @_ ;
-
-       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n" 
-           if $fetch_key ne $fk ;
-       print "# Fetch Value : expected '$fv' got '$fetch_value'\n" 
-           if $fetch_value ne $fv ;
-       print "# Store Key   : expected '$sk' got '$store_key'\n" 
-           if $store_key ne $sk ;
-       print "# Store Value : expected '$sv' got '$store_value'\n" 
-           if $store_value ne $sv ;
-       print "# \$_          : expected 'original' got '$_'\n" 
-           if $_ ne 'original' ;
-
-       return
-           $fetch_key   eq $fk && $store_key   eq $sk && 
-	   $fetch_value eq $fv && $store_value eq $sv &&
-	   $_ eq 'original' ;
-   }
-   
-   ok(99, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-   $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[0] = "joe" ;
-   #                   fk   sk     fv   sv
-   ok(100, checkOutput( "", 0, "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(101, $h[0] eq "joe");
-   #                   fk  sk  fv    sv
-   ok(102, checkOutput( "", 0, "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(103, $db->FIRSTKEY() == 0) ;
-   #                    fk     sk  fv  sv
-   ok(104, checkOutput( 0, "", "", "")) ;
-
-   # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
-   			(sub { ++ $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
-   			(sub { $_ *= 2 ; $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[1] = "Joe" ;
-   #                   fk   sk     fv    sv
-   ok(105, checkOutput( "", 2, "", "Jxe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(106, $h[1] eq "[Jxe]");
-   #                   fk   sk     fv    sv
-   ok(107, checkOutput( "", 2, "[Jxe]", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(108, $db->FIRSTKEY() == 1) ;
-   #                   fk   sk     fv    sv
-   ok(109, checkOutput( 1, "", "", "")) ;
-   
-   # 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[0] = "joe" ;
-   ok(110, checkOutput( "", 0, "", "joe")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(111, $h[0] eq "joe");
-   ok(112, checkOutput( "", 0, "joe", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(113, $db->FIRSTKEY() == 0) ;
-   ok(114, checkOutput( 0, "", "", "")) ;
-
-   # 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[0] = "joe" ;
-   ok(115, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(116, $h[0] eq "joe");
-   ok(117, checkOutput( "", "", "", "")) ;
-
-   ($fetch_key, $store_key, $fetch_value, $store_value) = ("") x 4 ;
-   ok(118, $db->FIRSTKEY() == 0) ;
-   ok(119, checkOutput( "", "", "", "")) ;
-
-   undef $db ;
-   ok(120, safeUntie \@h);
-   unlink $Dfile;
-}
-
-{    
-    # DBM Filter with a closure
-
-    use warnings ;
-    use strict ;
-    my (@h, $db) ;
-
-    unlink $Dfile;
-    ok(121, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-    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[0] = "joe" ;
-    ok(122, $result{"store key"} eq "store key - 1: [0]");
-    ok(123, $result{"store value"} eq "store value - 1: [joe]");
-    ok(124, ! defined $result{"fetch key"} );
-    ok(125, ! defined $result{"fetch value"} );
-    ok(126, $_ eq "original") ;
-
-    ok(127, $db->FIRSTKEY() == 0 ) ;
-    ok(128, $result{"store key"} eq "store key - 1: [0]");
-    ok(129, $result{"store value"} eq "store value - 1: [joe]");
-    ok(130, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(131, ! defined $result{"fetch value"} );
-    ok(132, $_ eq "original") ;
-
-    $h[7]  = "john" ;
-    ok(133, $result{"store key"} eq "store key - 2: [0 7]");
-    ok(134, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(135, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(136, ! defined $result{"fetch value"} );
-    ok(137, $_ eq "original") ;
-
-    ok(138, $h[0] eq "joe");
-    ok(139, $result{"store key"} eq "store key - 3: [0 7 0]");
-    ok(140, $result{"store value"} eq "store value - 2: [joe john]");
-    ok(141, $result{"fetch key"} eq "fetch key - 1: [0]");
-    ok(142, $result{"fetch value"} eq "fetch value - 1: [joe]");
-    ok(143, $_ eq "original") ;
-
-    undef $db ;
-    ok(144, safeUntie \@h);
-    unlink $Dfile;
-}		
-
-{
-   # DBM Filter recursion detection
-   use warnings ;
-   use strict ;
-   my (@h, $db) ;
-   unlink $Dfile;
-
-   ok(145, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-   $db->filter_store_key (sub { $_ = $h[0] }) ;
-
-   eval '$h[1] = 1234' ;
-   ok(146, $@ =~ /^recursion detected in filter_store_key at/ );
-   
-   undef $db ;
-   ok(147, safeUntie \@h);
-   unlink $Dfile;
-}
-
-
-{
-   # Examples from the POD
-
-  my $file = "xyzt" ;
-  {
-    my $redirect = new Redirect $file ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    use DB_File ;
-
-    my $filename = "text" ;
-    unlink $filename ;
-
-    my @h ;
-    my $x = tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO 
-        or die "Cannot open file 'text': $!\n" ;
-
-    # Add a few key/value pairs to the file
-    $h[0] = "orange" ;
-    $h[1] = "blue" ;
-    $h[2] = "yellow" ;
-
-    $FA ? push @h, "green", "black" 
-        : $x->push("green", "black") ;
-
-    my $elements = $FA ? scalar @h : $x->length ;
-    print "The array contains $elements entries\n" ;
-
-    my $last = $FA ? pop @h : $x->pop ;
-    print "popped $last\n" ;
-
-    $FA ? unshift @h, "white" 
-        : $x->unshift("white") ;
-    my $first = $FA ? shift @h : $x->shift ;
-    print "shifted $first\n" ;
-
-    # Check for existence of a key
-    print "Element 1 Exists with value $h[1]\n" if $h[1] ;
-
-    # use a negative index
-    print "The last element is $h[-1]\n" ;
-    print "The 2nd last element is $h[-2]\n" ;
-
-    undef $x ;
-    untie @h ;
-
-    unlink $filename ;
-  }  
-
-  ok(148, docat_del($file) eq <<'EOM') ;
-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
-EOM
-
-  my $save_output = "xyzt" ;
-  {
-    my $redirect = new Redirect $save_output ;
-
-    use warnings FATAL => qw(all);
-    use strict ;
-    our (@h, $H, $file, $i);
-    use DB_File ;
-    use Fcntl ;
-    
-    $file = "text" ;
-
-    unlink $file ;
-
-    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0640, $DB_RECNO 
-        or die "Cannot open file $file: $!\n" ;
-    
-    # first create a text file to play with
-    $h[0] = "zero" ;
-    $h[1] = "one" ;
-    $h[2] = "two" ;
-    $h[3] = "three" ;
-    $h[4] = "four" ;
-
-    
-    # Print the records in order.
-    #
-    # The length method is needed here because evaluating a tied
-    # array in a scalar context does not return the number of
-    # elements in the array.  
-
-    print "\nORIGINAL\n" ;
-    foreach $i (0 .. $H->length - 1) {
-        print "$i: $h[$i]\n" ;
-    }
-
-    # use the push & pop methods
-    $a = $H->pop ;
-    $H->push("last") ;
-    print "\nThe last record was [$a]\n" ;
-
-    # and the shift & unshift methods
-    $a = $H->shift ;
-    $H->unshift("first") ;
-    print "The first record was [$a]\n" ;
-
-    # Use the API to add a new record after record 2.
-    $i = 2 ;
-    $H->put($i, "Newbie", R_IAFTER) ;
-
-    # and a new record before record 1.
-    $i = 1 ;
-    $H->put($i, "New One", R_IBEFORE) ;
-
-    # delete record 3
-    $H->del(3) ;
-
-    # now print the records in reverse order
-    print "\nREVERSE\n" ;
-    for ($i = $H->length - 1 ; $i >= 0 ; -- $i)
-      { print "$i: $h[$i]\n" }
-
-    # same again, but use the API functions instead
-    print "\nREVERSE again\n" ;
-    my ($s, $k, $v)  = (0, 0, 0) ;
-    for ($s = $H->seq($k, $v, R_LAST) ; 
-             $s == 0 ; 
-             $s = $H->seq($k, $v, R_PREV))
-      { print "$k: $v\n" }
-
-    undef $H ;
-    untie @h ;    
-
-    unlink $file ;
-  }  
-
-  ok(149, docat_del($save_output) eq <<'EOM') ;
-
-ORIGINAL
-0: zero
-1: one
-2: two
-3: three
-4: four
-
-The last record was [four]
-The first record was [zero]
-
-REVERSE
-5: last
-4: three
-3: Newbie
-2: one
-1: New One
-0: first
-
-REVERSE again
-5: last
-4: three
-3: Newbie
-2: one
-1: New One
-0: first
-EOM
-   
-}
-
-{
-    # Bug ID 20001013.009
-    #
-    # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
-    use warnings ;
-    use strict ;
-    use DB_File ;
-
-    unlink $Dfile;
-    my @h ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
-	or die "Can't open file: $!\n" ;
-    $h[0] = undef;
-    ok(150, $a eq "") ;
-    ok(151, safeUntie \@h);
-    unlink $Dfile;
-}
-
-{
-    # test that %hash = () doesn't produce the warning
-    #     Argument "" isn't numeric in entersub
-    use warnings ;
-    use strict ;
-    use DB_File ;
-    my $a = "";
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-
-    unlink $Dfile;
-    my @h ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
-	or die "Can't open file: $!\n" ;
-    @h = (); ;
-    ok(152, $a eq "") ;
-    ok(153, safeUntie \@h);
-    unlink $Dfile;
-}
-
-{
-   # Check that DBM Filter can cope with read-only $_
-
-   use warnings ;
-   use strict ;
-   my (@h, $db) ;
-   unlink $Dfile;
-
-   ok(154, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-   $db->filter_fetch_key   (sub { }) ;
-   $db->filter_store_key   (sub { }) ;
-   $db->filter_fetch_value (sub { }) ;
-   $db->filter_store_value (sub { }) ;
-
-   $_ = "original" ;
-
-   $h[0] = "joe" ;
-   ok(155, $h[0] eq "joe");
-
-   eval { my @r= grep { $h[$_] } (1, 2, 3) };
-   ok (156, ! $@);
-
-
-   # delete the filters
-   $db->filter_fetch_key   (undef);
-   $db->filter_store_key   (undef);
-   $db->filter_fetch_value (undef);
-   $db->filter_store_value (undef);
-
-   $h[1] = "joe" ;
-
-   ok(157, $h[1] eq "joe");
-
-   eval { my @r= grep { $h[$_] } (1, 2, 3) };
-   ok (158, ! $@);
-
-   undef $db ;
-   untie @h;
-   unlink $Dfile;
-}
-
-{
-   # Check low-level API works with filter
-
-   use warnings ;
-   use strict ;
-   my (@h, $db) ;
-   my $Dfile = "xxy.db";
-   unlink $Dfile;
-
-   ok(159, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO ) );
-
-
-   $db->filter_fetch_key   (sub { ++ $_ } );
-   $db->filter_store_key   (sub { -- $_ } );
-   $db->filter_fetch_value (sub { $_ = unpack("i", $_) } );
-   $db->filter_store_value (sub { $_ = pack("i", $_) } );
-
-   $_ = 'fred';
-
-   my $key = 22 ;
-   my $value = 34 ;
-
-   $db->put($key, $value) ;
-   ok 160, $key == 22;
-   ok 161, $value == 34 ;
-   ok 162, $_ eq 'fred';
-   #print "k [$key][$value]\n" ;
-
-   my $val ;
-   $db->get($key, $val) ;
-   ok 163, $key == 22;
-   ok 164, $val == 34 ;
-   ok 165, $_ eq 'fred';
-
-   $key = 51 ;
-   $value = 454;
-   $h[$key] = $value ;
-   ok 166, $key == 51;
-   ok 167, $value == 454 ;
-   ok 168, $_ eq 'fred';
-
-   undef $db ;
-   untie @h;
-   unlink $Dfile;
-}
-
-
-{
-    # Regression Test for bug 30237
-    # Check that substr can be used in the key to db_put
-    # and that db_put does not trigger the warning
-    # 
-    #     Use of uninitialized value in subroutine entry
-
-
-    use warnings ;
-    use strict ;
-    my (@h, $db) ;
-    my $status ;
-    my $Dfile = "xxy.db";
-    unlink $Dfile;
-
-    ok(169, $db = tie(@h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO) );
-
-    my $warned = '';
-    local $SIG{__WARN__} = sub {$warned = $_[0]} ;
-
-    # db-put with substr of key
-    my %remember = () ;
-    for my $ix ( 0 .. 2 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{substr($key,0, 1)} = $value ;
-        $db->put(substr($key,0, 1), $value) ;
-    }
-
-    ok 170, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # db-put with substr of value
-    $warned = '';
-    for my $ix ( 3 .. 5 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$ix} = $value ;
-        $db->put($ix, substr($value,0)) ;
-    }
-
-    ok 171, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied array is not a problem, but check anyway
-    # substr of key
-    $warned = '';
-    for my $ix ( 6 .. 8 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{substr($key,0,1)} = $value ;
-        $h[substr($key,0,1)] = $value ;
-    }
-
-    ok 172, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    # via the tied array is not a problem, but check anyway
-    # substr of value
-    $warned = '';
-    for my $ix ( 9 .. 10 )
-    {
-        my $key = $ix . "data" ;
-        my $value = "value$ix" ;
-        $remember{$ix} = $value ;
-        $h[$ix] = substr($value,0) ;
-    }
-
-    ok 173, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-
-    my %bad = () ;
-    my $key = '';
-    for (my $status = $db->seq($key, $value, R_FIRST ) ;
-         $status == 0 ;
-         $status = $db->seq($key, $value, R_NEXT ) ) {
-
-        #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
-             $remember{$key} eq $value) {
-            delete $remember{$key} ;
-        }
-        else {
-            $bad{$key} = $value ;
-        }
-    }
-    
-    ok 174, keys %bad == 0 ;
-    ok 175, keys %remember == 0 ;
-
-    print "# missing -- $key $value\n" while ($key, $value) = each %remember;
-    print "# bad     -- $key $value\n" while ($key, $value) = each %bad;
-
-    # Make sure this fix does not break code to handle an undef key
-    my $value = 'fred';
-    $warned = '';
-    $status = $db->put(undef, $value) ;
-    ok 176, $status == 0
-      or print "# put failed - status $status\n";
-    ok 177, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    print "# db_ver $DB_File::db_ver\n";
-    $value = '' ;
-    $status = $db->get(undef, $value) ;
-    ok 178, $status == 0
-	or print "# get failed - status $status\n" ;
-    ok(179, $db->get(undef, $value) == 0) or print "# get failed\n" ;
-    ok 180, $value eq 'fred' or print "# got [$value]\n" ;
-    ok 181, $warned eq '' 
-      or print "# Caught warning [$warned]\n" ;
-    $warned = '';
-
-    undef $db ;
-    untie @h;
-    unlink $Dfile;
-}
-
-# Only test splice if this is a newish version of Perl
-exit unless $FA ;
-
-# Test SPLICE
-
-{
-    # check that the splice warnings are under the same lexical control
-    # as their non-tied counterparts.
-
-    use warnings;
-    use strict;
-
-    my $a = '';
-    my @a = (1);
-    local $SIG{__WARN__} = sub {$a = $_[0]} ;
-
-    unlink $Dfile;
-    my @tied ;
-    
-    tie @tied, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
-	or die "Can't open file: $!\n" ;
-
-    # uninitialized offset
-    use warnings;
-    my $offset ;
-    $a = '';
-    splice(@a, $offset);
-    ok(182, $a =~ /^Use of uninitialized value /);
-    $a = '';
-    splice(@tied, $offset);
-    ok(183, $a =~ /^Use of uninitialized value in splice/);
-
-    no warnings 'uninitialized';
-    $a = '';
-    splice(@a, $offset);
-    ok(184, $a eq '');
-    $a = '';
-    splice(@tied, $offset);
-    ok(185, $a eq '');
-
-    # uninitialized length
-    use warnings;
-    my $length ;
-    $a = '';
-    splice(@a, 0, $length);
-    ok(186, $a =~ /^Use of uninitialized value /);
-    $a = '';
-    splice(@tied, 0, $length);
-    ok(187, $a =~ /^Use of uninitialized value in splice/);
-
-    no warnings 'uninitialized';
-    $a = '';
-    splice(@a, 0, $length);
-    ok(188, $a eq '');
-    $a = '';
-    splice(@tied, 0, $length);
-    ok(189, $a eq '');
-
-    # offset past end of array
-    use warnings;
-    $a = '';
-    splice(@a, 3);
-    my $splice_end_array = ($a =~ /^splice\(\) offset past end of array/);
-    $a = '';
-    splice(@tied, 3);
-    ok(190, !$splice_end_array || $a =~ /^splice\(\) offset past end of array/);
-
-    no warnings 'misc';
-    $a = '';
-    splice(@a, 3);
-    ok(191, $a eq '');
-    $a = '';
-    splice(@tied, 3);
-    ok(192, $a eq '');
-
-    ok(193, safeUntie \@tied);
-    unlink $Dfile;
-}
-
-# 
-# These are a few regression tests: bundles of five arguments to pass
-# to test_splice().  The first four arguments correspond to those
-# given to splice(), and the last says which context to call it in
-# (scalar, list or void).
-# 
-# The expected result is not needed because we get that by running
-# Perl's built-in splice().
-# 
-my @tests = ([ [ 'falsely', 'dinosaur', 'remedy', 'commotion',
-		 'rarely', 'paleness' ],
-	       -4, -2,
-	       [ 'redoubled', 'Taylorize', 'Zoe', 'halogen' ],
-	       'void' ],
-
-	     [ [ 'a' ], -2, 1, [ 'B' ], 'void' ],
-
-	     [ [ 'Hartley', 'Islandia', 'assents', 'wishful' ],
-	       0, -4,
-	       [ 'maids' ],
-	       'void' ],
-
-	     [ [ 'visibility', 'pocketful', 'rectangles' ],
-	       -10, 0,
-	       [ 'garbages' ],
-	       'void' ],
-
-	     [ [ 'sleeplessly' ],
-	       8, -4,
-	       [ 'Margery', 'clearing', 'repercussion', 'clubs',
-		 'arise' ],
-	       'void' ],
-
-	     [ [ 'chastises', 'recalculates' ],
-	       0, 0,
-	       [ 'momentariness', 'mediates', 'accents', 'toils',
-		 'regaled' ],
-	       'void' ],
-
-	     [ [ 'b', '' ],
-	       9, 8,
-	       [ 'otrb', 'stje', 'ixrpw', 'vxfx', 'lhhf' ],
-	       'scalar' ],
-
-	     [ [ 'b', '' ],
-	       undef, undef,
-	       [ 'otrb', 'stje', 'ixrpw', 'vxfx', 'lhhf' ],
-	       'scalar' ],
-	     
-	     [ [ 'riheb' ], -8, undef, [], 'void' ],
-
-	     [ [ 'uft', 'qnxs', '' ],
-	       6, -2,
-	       [ 'znp', 'mhnkh', 'bn' ],
-	       'void' ],
-	    );
-
-my $testnum = 194;
-my $failed = 0;
-my $tmp = "dbr$$";
-foreach my $test (@tests) {
-    my $err = test_splice(@$test);
-    if (defined $err) {
-	print STDERR "# failed: ", Dumper($test);
-	print STDERR "# error: $err\n";
-	$failed = 1;
-	ok($testnum++, 0);
-    }
-    else { ok($testnum++, 1) }
-}
-
-if ($failed) {
-    # Not worth running the random ones
-    print STDERR '# skipping ', $testnum++, "\n";
-}
-else {
-    # A thousand randomly-generated tests
-    $failed = 0;
-    srand(0);
-    foreach (0 .. 1000 - 1) {
-	my $test = rand_test();
-	my $err = test_splice(@$test);
-	if (defined $err) {
-	    print STDERR "# failed: ", Dumper($test);
-	    print STDERR "# error: $err\n";
-	    $failed = 1;
-	    print STDERR "# skipping any remaining random tests\n";
-	    last;
-	}
-    }
-
-    ok($testnum++, not $failed);
-}
-
-die "testnum ($testnum) != total_tests ($total_tests) + 1" 
-    if $testnum != $total_tests + 1;
-
-exit ;
-
-# Subroutines for SPLICE testing
-
-# test_splice()
-# 
-# Test the new splice() against Perl's built-in one.  The first four
-# parameters are those passed to splice(), except that the lists must
-# be (explicitly) passed by reference, and are not actually modified.
-# (It's just a test!)  The last argument specifies the context in
-# which to call the functions: 'list', 'scalar', or 'void'.
-# 
-# Returns:
-#   undef, if the two splices give the same results for the given
-#     arguments and context;
-# 
-#   an error message showing the difference, otherwise.
-# 
-# Reads global variable $tmp.
-# 
-sub test_splice {
-    die 'usage: test_splice(array, offset, length, list, context)' if @_ != 5;
-    my ($array, $offset, $length, $list, $context) = @_;
-    my @array = @$array;
-    my @list = @$list;
-
-    unlink $tmp;
-    
-    my @h;
-    my $H = tie @h, 'DB_File', $tmp, O_CREAT|O_RDWR, 0644, $DB_RECNO
-      or die "cannot open $tmp: $!";
-
-    my $i = 0;
-    foreach ( @array ) { $h[$i++] = $_ }
-    
-    return "basic DB_File sanity check failed"
-      if list_diff(\@array, \@h);
-
-    # Output from splice():
-    # Returned value (munged a bit), error msg, warnings
-    # 
-    my ($s_r, $s_error, @s_warnings);
-
-    my $gather_warning = sub { push @s_warnings, $_[0] };
-    if ($context eq 'list') {
-	my @r;
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    @r = splice @array, $offset, $length, @list;
-	};
-	$s_error = $@;
-	$s_r = \@r;
-    }
-    elsif ($context eq 'scalar') {
-	my $r;
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    $r = splice @array, $offset, $length, @list;
-	};
-	$s_error = $@;
-	$s_r = [ $r ];
-    }
-    elsif ($context eq 'void') {
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    splice @array, $offset, $length, @list;
-	};
-	$s_error = $@;
-	$s_r = [];
-    }
-    else {
-	die "bad context $context";
-    }
-
-    foreach ($s_error, @s_warnings) {
-	chomp;
-	s/ at \S+ line \d+\.$//;
-	# only built-in splice identifies name of uninit value
-	s/(uninitialized value) \$\w+/$1/;
-    }
-
-    # Now do the same for DB_File's version of splice
-    my ($ms_r, $ms_error, @ms_warnings);
-    $gather_warning = sub { push @ms_warnings, $_[0] };
-    if ($context eq 'list') {
-	my @r;
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    @r = splice @h, $offset, $length, @list;
-	};
-	$ms_error = $@;
-	$ms_r = \@r;
-    }
-    elsif ($context eq 'scalar') {
-	my $r;
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    $r = splice @h, $offset, $length, @list;
-	};
-	$ms_error = $@;
-	$ms_r = [ $r ];
-    }
-    elsif ($context eq 'void') {
-	eval {
-	    local $SIG{__WARN__} = $gather_warning;
-	    splice @h, $offset, $length, @list;
-	};
-	$ms_error = $@;
-	$ms_r = [];
-    }
-    else {
-	die "bad context $context";
-    }
-
-    foreach ($ms_error, @ms_warnings) {
-	chomp;
-    s/ at \S+(\s+\S+)*? line \d+\.?.*//s;
-    }
-
-    return "different errors: '$s_error' vs '$ms_error'"
-      if $s_error ne $ms_error;
-    return('different return values: ' . Dumper($s_r) . ' vs ' . Dumper($ms_r))
-      if list_diff($s_r, $ms_r);
-    return('different changed list: ' . Dumper(\@array) . ' vs ' . Dumper(\@h))
-      if list_diff(\@array, \@h);
-
-    if ((scalar @s_warnings) != (scalar @ms_warnings)) {
-	return 'different number of warnings';
-    }
-
-    while (@s_warnings) {
-	my $sw  = shift @s_warnings;
-	my $msw = shift @ms_warnings;
-	
-	if (defined $sw and defined $msw) {
-	    $msw =~ s/ \(.+\)$//;
-	    $msw =~ s/ in splice$// if $] < 5.006;
-	    if ($sw ne $msw) {
-		return "different warning: '$sw' vs '$msw'";
-	    }
-	}
-	elsif (not defined $sw and not defined $msw) {
-	    # Okay.
-	}
-	else {
-	    return "one warning defined, another undef";
-	}
-    }
-    
-    undef $H;
-    untie @h;
-    
-    open(TEXT, $tmp) or die "cannot open $tmp: $!";
-    @h = <TEXT>; normalise @h; chomp @h;
-    close TEXT or die "cannot close $tmp: $!";
-    return('list is different when re-read from disk: '
-	   . Dumper(\@array) . ' vs ' . Dumper(\@h))
-      if list_diff(\@array, \@h);
-
-    unlink $tmp;
-
-    return undef; # success
-}
-
-
-# list_diff()
-#
-# Do two lists differ?
-#
-# Parameters:
-#   reference to first list
-#   reference to second list
-#
-# Returns true iff they differ.  Only works for lists of (string or
-# undef). 
-# 
-# Surely there is a better way to do this?
-# 
-sub list_diff {
-    die 'usage: list_diff(ref to first list, ref to second list)'
-      if @_ != 2;
-    my ($a, $b) = @_;
-    my @a = @$a; my @b = @$b;
-    return 1 if (scalar @a) != (scalar @b);
-    for (my $i = 0; $i < @a; $i++) {
-	my ($ae, $be) = ($a[$i], $b[$i]);
-	if (defined $ae and defined $be) {
-	    return 1 if $ae ne $be;
-	}
-	elsif (not defined $ae and not defined $be) {
-	    # Two undefined values are 'equal'
-	}
-	else {
-	    return 1;
-	}
-    }
-    return 0;
-} 
-
-
-# rand_test()
-# 
-# Think up a random ARRAY, OFFSET, LENGTH, LIST, and context.
-# ARRAY or LIST might be empty, and OFFSET or LENGTH might be
-# undefined.  Return a 'test' - a listref of these five things.
-# 
-sub rand_test {
-    die 'usage: rand_test()' if @_;
-    my @contexts = qw<list scalar void>;
-    my $context = $contexts[int(rand @contexts)];
-    return [ rand_list(),
-	     (rand() < 0.5) ? (int(rand(20)) - 10) : undef,
-	     (rand() < 0.5) ? (int(rand(20)) - 10) : undef,
-	     rand_list(),
-	     $context ];
-}
-
-
-sub rand_list {
-    die 'usage: rand_list()' if @_;
-    my @r;
-
-    while (rand() > 0.1 * (scalar @r + 1)) {
-	push @r, rand_word();
-    }
-    return \@r;
-}
-
-
-sub rand_word {
-    die 'usage: rand_word()' if @_;
-    my $r = '';
-    my @chars = qw<a b c d e f g h i j k l m n o p q r s t u v w x y z>;
-    while (rand() > 0.1 * (length($r) + 1)) {
-	$r .= $chars[int(rand(scalar @chars))];
-    }
-    return $r;
-}
-
-
diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap
deleted file mode 100644
index c46b6851d7..0000000000
--- a/ext/DB_File/typemap
+++ /dev/null
@@ -1,57 +0,0 @@
-# typemap for Perl 5 interface to Berkeley 
-#
-# written by Paul Marquess <Paul.Marquess@btinternet.com>
-# last modified 20th June 2004
-# version 1.809
-#
-#################################### DB SECTION
-#
-# 
-
-u_int			T_U_INT
-DB_File			T_PTROBJ
-DBT			T_dbtdatum
-DBTKEY			T_dbtkeydatum
-
-INPUT
-T_dbtkeydatum
-    {
-	SV * my_sv = $arg;
-	DBM_ckFilter(my_sv, filter_store_key, \"filter_store_key\");
-	DBT_clear($var) ;
-	SvGETMAGIC(my_sv) ;
-        if (db->type == DB_RECNO) {
-	    if (SvOK(my_sv))
-	        Value = GetRecnoKey(aTHX_ db, SvIV(my_sv)) ; 
-            else
-	        Value = 1 ;
-	    $var.data = & Value; 
-	    $var.size = (int)sizeof(recno_t);
-        }
-        else if (SvOK(my_sv)) {
-	    STRLEN len;
-	    $var.data = SvPVbyte(my_sv, len);
-	    $var.size = (int)len;
-	}
-    }
-T_dbtdatum
-    {
-	SV * my_sv = $arg;
-	DBM_ckFilter(my_sv, filter_store_value, \"filter_store_value\");
-	DBT_clear($var) ;
-	SvGETMAGIC(my_sv) ;
-	if (SvOK(my_sv)) {
-	    STRLEN len;
-	    $var.data = SvPVbyte(my_sv, len);
-	    $var.size = (int)len;
-	}
-    }
-
-OUTPUT
-
-T_dbtkeydatum
-	OutputKey($arg, $var)
-T_dbtdatum
-	OutputValue($arg, $var)
-T_PTROBJ
-        sv_setref_pv($arg, dbtype, (void*)$var);
diff --git a/ext/DB_File/version.c b/ext/DB_File/version.c
deleted file mode 100644
index 47158d3368..0000000000
--- a/ext/DB_File/version.c
+++ /dev/null
@@ -1,83 +0,0 @@
-/* 
-
- version.c -- Perl 5 interface to Berkeley DB 
-
- written by Paul Marquess <Paul.Marquess@btinternet.com>
- last modified 2nd Jan 2002
- version 1.802
-
- All comments/suggestions/problems are welcome
-
-     Copyright (c) 1995-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.
-
- Changes:
-        1.71 -  Support for Berkeley DB version 3.
-		Support for Berkeley DB 2/3's backward compatability mode.
-        1.72 -  No change.
-        1.73 -  Added support for threading
-        1.74 -  Added Perl core patch 7801.
-
-
-*/
-
-#define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"  
-#include "perl.h"
-#include "XSUB.h"
-
-#include <db.h>
-
-void
-#ifdef CAN_PROTOTYPE
-__getBerkeleyDBInfo(void)
-#else
-__getBerkeleyDBInfo()
-#endif
-{
-#ifdef dTHX	
-    dTHX;
-#endif    
-    SV * version_sv = perl_get_sv("DB_File::db_version", GV_ADD|GV_ADDMULTI) ;
-    SV * ver_sv = perl_get_sv("DB_File::db_ver", GV_ADD|GV_ADDMULTI) ;
-    SV * compat_sv = perl_get_sv("DB_File::db_185_compat", GV_ADD|GV_ADDMULTI) ;
-
-#ifdef DB_VERSION_MAJOR
-    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("\nDB_File was build with libdb version %d.%d.%d,\nbut you are attempting to run it with libdb version %d.%d.%d\n",
-		DB_VERSION_MAJOR, DB_VERSION_MINOR, DB_VERSION_PATCH, 
-		Major, Minor, Patch) ;
-    
-    /* check that libdb is recent enough  -- we need 2.3.4 or greater */
-    if (Major == 2 && (Minor < 3 || (Minor ==  3 && Patch < 4)))
-	croak("DB_File needs Berkeley DB 2.3.4 or greater, you have %d.%d.%d\n",
-		 Major, Minor, Patch) ;
- 
-    {
-        char buffer[40] ;
-        sprintf(buffer, "%d.%d", Major, Minor) ;
-        sv_setpv(version_sv, buffer) ; 
-        sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
-        sv_setpv(ver_sv, buffer) ; 
-    }
- 
-#else /* ! DB_VERSION_MAJOR */
-    sv_setiv(version_sv, 1) ;
-    sv_setiv(ver_sv, 1) ;
-#endif /* ! DB_VERSION_MAJOR */
-
-#ifdef COMPAT185
-    sv_setiv(compat_sv, 1) ;
-#else /* ! COMPAT185 */
-    sv_setiv(compat_sv, 0) ;
-#endif /* ! COMPAT185 */
-
-}