This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update DB_File to CPAN version 1.854
authorTodd Rinaldo <toddr@cpan.org>
Wed, 16 Sep 2020 15:01:31 +0000 (10:01 -0500)
committerℕicolas ℝ <nicolas@atoomic.org>
Wed, 16 Sep 2020 16:33:54 +0000 (10:33 -0600)
[DELTA]

1.854 16 September 2020

* Prefer direct notation over indirect (#4)
* Make hint/BS snippets strict compliant.
* trim whitespace

18 files changed:
Porting/Maintainers.pl
cpan/DB_File/DB_File.pm
cpan/DB_File/DB_File.xs
cpan/DB_File/DB_File_BS
cpan/DB_File/Makefile.PL
cpan/DB_File/config.in
cpan/DB_File/dbinfo
cpan/DB_File/hints/bitrig.pl
cpan/DB_File/hints/dynixptx.pl
cpan/DB_File/hints/minix.pl
cpan/DB_File/hints/netbsd.pl
cpan/DB_File/hints/openbsd.pl
cpan/DB_File/hints/sco.pl
cpan/DB_File/t/db-btree.t
cpan/DB_File/t/db-hash.t
cpan/DB_File/t/db-recno.t
cpan/DB_File/t/db-threads.t
cpan/DB_File/version.c

index fc46607..c146cb0 100755 (executable)
@@ -325,7 +325,7 @@ use File::Glob qw(:case);
     },
 
     'DB_File' => {
-        'DISTRIBUTION' => 'PMQS/DB_File-1.853.tar.gz',
+        'DISTRIBUTION' => 'PMQS/DB_File-1.854.tar.gz',
         'FILES'        => q[cpan/DB_File],
         'EXCLUDED'     => [
             qr{^patches/},
index a732ff4..e5e0d86 100644 (file)
@@ -1,4 +1,4 @@
-# DB_File.pm -- Perl 5 interface to Berkeley DB 
+# DB_File.pm -- Perl 5 interface to Berkeley DB
 #
 # Written by Paul Marquess (pmqs@cpan.org)
 #
@@ -30,21 +30,21 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless { VALID => { 
+    bless { VALID => {
                         bsize     => 1,
                         ffactor   => 1,
                         nelem     => 1,
                         cachesize => 1,
                         hash      => 2,
                         lorder    => 1,
-                     }, 
+                     },
             GOT   => {}
           }, $pkg ;
 }
 
 
-sub FETCH 
-{  
+sub FETCH
+{
     my $self  = shift ;
     my $key   = shift ;
 
@@ -55,7 +55,7 @@ sub FETCH
 }
 
 
-sub STORE 
+sub STORE
 {
     my $self  = shift ;
     my $key   = shift ;
@@ -65,17 +65,17 @@ sub STORE
 
     if ( $type )
     {
-        croak "Key '$key' not associated with a code reference" 
+        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 
+sub DELETE
 {
     my $self = shift ;
     my $key  = shift ;
@@ -85,7 +85,7 @@ sub DELETE
         delete $self->{GOT}{$key} ;
         return ;
     }
-    
+
     my $pkg = ref $self ;
     croak "DB_File::HASHINFO::DELETE - Unknown element '$key'" ;
 }
@@ -121,7 +121,7 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless { VALID => { map {$_, 1} 
+    bless { VALID => { map {$_, 1}
                        qw( bval cachesize psize flags lorder reclen bfname )
                      },
             GOT   => {},
@@ -139,7 +139,7 @@ sub TIEHASH
 {
     my $pkg = shift ;
 
-    bless { VALID => { 
+    bless { VALID => {
                         flags      => 1,
                         cachesize  => 1,
                         maxkeypage => 1,
@@ -163,28 +163,28 @@ our ($db_version, $use_XSLoader, $splice_end_array_no_length, $splice_end_array,
 use Carp;
 
 # Module not thread safe, so don't clone
-sub CLONE_SKIP { 1 } 
+sub CLONE_SKIP { 1 }
 
-$VERSION = "1.853" ;
+$VERSION = "1.854" ;
 $VERSION = eval $VERSION; # needed for dev releases
 
 {
     local $SIG{__WARN__} = sub {$splice_end_array_no_length = join(" ",@_);};
     my @a =(1); splice(@a, 3);
-    $splice_end_array_no_length = 
+    $splice_end_array_no_length =
         ($splice_end_array_no_length =~ /^splice\(\) offset past end of array at /);
-}      
+}
 {
     local $SIG{__WARN__} = sub {$splice_end_array = join(" ", @_);};
     my @a =(1); splice(@a, 3, 1);
-    $splice_end_array = 
+    $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 ;
+$DB_BTREE = DB_File::BTREEINFO->new();
+$DB_HASH  = DB_File::HASHINFO->new();
+$DB_RECNO = DB_File::RECNOINFO->new();
 
 require Tie::Hash;
 require Exporter;
@@ -201,7 +201,7 @@ BEGIN {
 
 push @ISA, qw(Tie::Hash Exporter);
 @EXPORT = qw(
-        $DB_BTREE $DB_HASH $DB_RECNO 
+        $DB_BTREE $DB_HASH $DB_RECNO
 
         BTREEMAGIC
         BTREEVERSION
@@ -242,7 +242,7 @@ sub AUTOLOAD {
     no strict 'refs';
     *{$AUTOLOAD} = sub { $val };
     goto &{$AUTOLOAD};
-}           
+}
 
 
 eval {
@@ -256,7 +256,7 @@ eval {
 if ($use_XSLoader)
   { XSLoader::load("DB_File", $VERSION)}
 else
-  { bootstrap DB_File $VERSION }
+  { DB_File->bootstrap( $VERSION ) }
 
 sub tie_hash_or_array
 {
@@ -264,22 +264,22 @@ sub tie_hash_or_array
     my $tieHASH = ( (caller(1))[3] =~ /TIEHASH/ ) ;
 
     use File::Spec;
-    $arg[1] = File::Spec->rel2abs($arg[1]) 
+    $arg[1] = File::Spec->rel2abs($arg[1])
         if defined $arg[1] ;
 
-    $arg[4] = tied %{ $arg[4] } 
+    $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 
+    # 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 
+    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 ;
@@ -299,20 +299,20 @@ sub TIEARRAY
     tie_hash_or_array(@_) ;
 }
 
-sub CLEAR 
+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); 
+        my $s = $self->del($key);
     }
 }
 
@@ -333,7 +333,7 @@ sub STORESIZE
         $self->put($length-1, "") ;
     }
 }
+
 
 sub SPLICE
 {
@@ -348,15 +348,15 @@ sub SPLICE
     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) {
@@ -384,7 +384,7 @@ sub SPLICE
 
     # 'If LENGTH is negative, leave that many elements off the end of
     # the array.'
-    # 
+    #
     if ($length < 0) {
         $length = $size - $offset + $length;
 
@@ -392,7 +392,7 @@ sub SPLICE
             # 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;
         }
     }
@@ -406,7 +406,7 @@ sub SPLICE
 
     # 'Removes the elements designated by OFFSET and LENGTH from an
     # array,'...
-    # 
+    #
     my @removed = ();
     foreach (0 .. $length - 1) {
         my $old;
@@ -480,13 +480,13 @@ sub SPLICE
     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";
@@ -506,7 +506,7 @@ 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);
@@ -526,7 +526,7 @@ 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) ;
@@ -540,7 +540,7 @@ sub get_dup
 {
     croak "Usage: \$db->get_dup(key [,flag])\n"
         unless @_ == 2 or @_ == 3 ;
+
     my $db        = shift ;
     my $key       = shift ;
     my $flag      = shift ;
@@ -551,13 +551,13 @@ sub get_dup
     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)
@@ -567,9 +567,9 @@ sub get_dup
         }
         else
             { ++ $counter }
-     
+
     }
+
     return ($wantarray ? ($flag ? %values : @values) : $counter) ;
 }
 
@@ -723,7 +723,7 @@ 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, 
+      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
@@ -749,7 +749,7 @@ 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>. 
+C<ffactor>, C<hash>, C<lorder> and C<nelem>.
 
 To change one of these elements, just assign to it like this:
 
@@ -763,7 +763,7 @@ 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 = DB_File::HASHINFO->new();
      $a->{'bsize'} ;
      $a->{'cachesize'} ;
      $a->{'ffactor'};
@@ -771,7 +771,7 @@ for DB_HASH, DB_BTREE and DB_RECNO respectively.
      $a->{'lorder'} ;
      $a->{'nelem'} ;
 
-     $b = new DB_File::BTREEINFO ;
+     $b = DB_File::BTREEINFO->new();
      $b->{'flags'} ;
      $b->{'cachesize'} ;
      $b->{'maxkeypage'} ;
@@ -781,7 +781,7 @@ for DB_HASH, DB_BTREE and DB_RECNO respectively.
      $b->{'prefix'} ;
      $b->{'lorder'} ;
 
-     $c = new DB_File::RECNOINFO ;
+     $c = DB_File::RECNOINFO->new();
      $c->{'bval'} ;
      $c->{'cachesize'} ;
      $c->{'psize'} ;
@@ -795,7 +795,7 @@ 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 = DB_File::HASHINFO->new();
      $a->{'cachesize'} =  12345 ;
      tie %y, 'DB_File', "filename", $flags, 0777, $a ;
 
@@ -826,7 +826,7 @@ to Perl subs. Below are templates for each of the subs:
     {
         my ($key, $key2) = @_ ;
         ...
-        # return number of bytes of $key2 which are 
+        # return number of bytes of $key2 which are
         # necessary to determine that it is greater than $key1
         return $bytes ;
     }
@@ -885,7 +885,7 @@ contents of the database.
     our (%h, $k, $v) ;
 
     unlink "fruit" ;
-    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0666, $DB_HASH 
+    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
@@ -946,7 +946,7 @@ insensitive compare function will be used.
     $DB_BTREE->{'compare'} = \&Compare ;
 
     unlink "tree" ;
-    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    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
@@ -1016,9 +1016,9 @@ possible to recover the original keys in sets of keys that
 compared as equal).
 
 
-=back 
+=back
 
-=head2 Handling Duplicate Keys 
+=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
@@ -1040,7 +1040,7 @@ code:
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
 
-    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    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
@@ -1095,7 +1095,7 @@ Here is the script above rewritten using the C<seq> API method.
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    $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
@@ -1127,7 +1127,7 @@ that prints:
 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 
+To make life easier when dealing with duplicate keys, B<DB_File> comes with
 a few utility methods.
 
 =head2 The get_dup() Method
@@ -1166,7 +1166,7 @@ this:
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    $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") ;
@@ -1200,7 +1200,7 @@ and it will print:
     $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 
+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:
@@ -1216,13 +1216,13 @@ Assuming the database from the previous example:
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    $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") ; 
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
     print "Larry Wall is $found there\n" ;
 
-    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
+    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ;
     print "Harry Wall is $found there\n" ;
 
     undef $x ;
@@ -1255,12 +1255,12 @@ Again assuming the existence of the C<tree> database
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
 
-    $x = tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_BTREE 
+    $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") ; 
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
     print "Larry Wall is $found there\n" ;
 
     undef $x ;
@@ -1270,7 +1270,7 @@ prints this
 
     Larry Wall is not there
 
-=head2 Matching Partial Keys 
+=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
@@ -1314,7 +1314,7 @@ and print the first matching key/value pair given a partial key.
     # Add some key/value pairs to the file
     $h{'mouse'} = 'mickey' ;
     $h{'Wall'} = 'Larry' ;
-    $h{'Walls'} = 'Brick' ; 
+    $h{'Walls'} = 'Brick' ;
     $h{'Smith'} = 'John' ;
 
 
@@ -1393,8 +1393,8 @@ 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 
+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 ;
@@ -1405,7 +1405,7 @@ L<Extra RECNO Methods> for a workaround).
     unlink $filename ;
 
     my @h ;
-    tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0666, $DB_RECNO 
+    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
@@ -1488,7 +1488,7 @@ Returns a splice of the array.
 =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 
+described above. It also makes use of the API interface directly (see
 L<THE API INTERFACE>).
 
     use warnings ;
@@ -1501,7 +1501,7 @@ L<THE API INTERFACE>).
 
     unlink $file ;
 
-    $H = tie @h, "DB_File", $file, O_RDWR|O_CREAT, 0666, $DB_RECNO 
+    $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
@@ -1516,7 +1516,7 @@ L<THE API INTERFACE>).
     #
     # 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.  
+    # elements in the array.
 
     print "\nORIGINAL\n" ;
     foreach $i (0 .. $H->length - 1) {
@@ -1552,8 +1552,8 @@ L<THE API INTERFACE>).
     # 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 ; 
+    for ($s = $H->seq($k, $v, R_LAST) ;
+             $s == 0 ;
              $s = $H->seq($k, $v, R_PREV))
       { print "$k: $v\n" }
 
@@ -1600,7 +1600,7 @@ Rather than iterating through the array, C<@h> like this:
 
 it is necessary to use either this:
 
-    foreach $i (0 .. $H->length - 1) 
+    foreach $i (0 .. $H->length - 1)
 
 or this:
 
@@ -1635,10 +1635,10 @@ as B<DB_File> methods directly like this:
 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. 
+destroyed.
 
     use DB_File ;
-    $db = tie %hash, "DB_File", "filename" 
+    $db = tie %hash, "DB_File", "filename"
         or die "Cannot tie filename: $!" ;
     ...
     undef $db ;
@@ -1685,7 +1685,7 @@ code will probably not do what you expect:
     $X->seq($key, $value, R_FIRST) ;
 
     # this line will modify the cursor
-    $count = scalar keys %x ; 
+    $count = scalar keys %x ;
 
     # Get the second key/value pair.
     # oops, it didn't, it got the last key/value pair!
@@ -1697,7 +1697,7 @@ The code above can be rearranged to get around the problem, like this:
         or die "Cannot tie $filename: $!" ;
 
     # this line will modify the cursor
-    $count = scalar keys %x ; 
+    $count = scalar keys %x ;
 
     # Get the first key/value pair and set  the cursor
     $X->seq($key, $value, R_FIRST) ;
@@ -1788,7 +1788,7 @@ Using the low-level API defined below.
 
 =item 2.
 
-Using the L<DBM_Filter> module. 
+Using the L<DBM_Filter> module.
 This module hides the complexity of the API defined below and comes
 with a number of "canned" filters that cover some of the common use-cases.
 
@@ -1872,7 +1872,7 @@ fix very easily.
     my $filename = "filt" ;
     unlink $filename ;
 
-    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
+    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH
       or die "Cannot open $filename: $!\n" ;
 
     # Install DBM Filters
@@ -1915,7 +1915,7 @@ Here is a DBM Filter that does it:
     unlink $filename ;
 
 
-    my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
+    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", $_) } ) ;
@@ -1929,7 +1929,7 @@ 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 
+=head1 HINTS AND TIPS
 
 
 =head2 Locking: The Trouble with fd
@@ -1940,7 +1940,7 @@ 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. 
+The locking technique went like this.
 
     $db = tie(%db, 'DB_File', 'foo.db', O_CREAT|O_RDWR, 0644)
         || die "dbcreat foo.db $!";
@@ -2031,7 +2031,7 @@ 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> 
+=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
@@ -2041,7 +2041,7 @@ 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> 
+=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
@@ -2113,7 +2113,7 @@ F<authors/id/TOMC/scripts/nshist.gz>).
 =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>. 
+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.
@@ -2215,12 +2215,12 @@ B<DBM_Filter> (see L<DBM_Filter>) that was designed to deal with this
 situation.
 
 The example below shows what you need if I<both> the key and value are
-expected to be in UTF-8. 
+expected to be in UTF-8.
 
     use DB_File;
-    use DBM_Filter; 
+    use DBM_Filter;
 
-    my $db = tie %h, 'DB_File', '/tmp/try.db', O_CREAT|O_RDWR, 0666, $DB_BTREE; 
+    my $db = tie %h, 'DB_File', '/tmp/try.db', O_CREAT|O_RDWR, 0666, $DB_BTREE;
     $db->Filter_Key_Push('utf8');
     $db->Filter_Value_Push('utf8');
 
@@ -2240,7 +2240,7 @@ Here are a couple of possibilities:
 
 =item 1.
 
-Attempting to reopen a database without closing it. 
+Attempting to reopen a database without closing it.
 
 =item 2.
 
@@ -2248,7 +2248,7 @@ Using the O_WRONLY flag.
 
 =back
 
-=head2 What does "Bareword 'DB_File' not allowed" mean? 
+=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.
@@ -2262,7 +2262,7 @@ Consider this script:
 
 Running it produces the error in question:
 
-    Bareword "DB_File" not allowed while "strict subs" in use 
+    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:
@@ -2300,7 +2300,7 @@ suggest any enhancements, I would welcome your comments.
 
 =head1 SUPPORT
 
-General feedback/questions/bug reports should be sent to 
+General feedback/questions/bug reports should be sent to
 L<https://github.com/pmqs/DB_File/issues> (preferred) or
 L<https://rt.cpan.org/Public/Dist/Display.html?Name=DB_File>.
 
@@ -2336,7 +2336,7 @@ copyright and its own license. Please take the time to read it.
 Here are a few words taken from the Berkeley DB FAQ (at
 L<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? 
+    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
index ab95369..7b47395 100644 (file)
@@ -1527,12 +1527,12 @@ SV *   sv ;
         status = (RETVAL->dbp->open)(RETVAL->dbp, name, NULL, RETVAL->type,
                     Flags, mode) ;
 #endif
-        Trace(("open returned %d %s\n", status, db_strerror(status))) ; 
+        Trace(("open returned %d %s\n", status, db_strerror(status))) ;
 
         if (status == 0) {
 
             status = (RETVAL->dbp->cursor)(RETVAL->dbp, NULL, &RETVAL->cursor, 0) ;
-            Trace(("cursor returned %d %s\n", status, db_strerror(status))) ; 
+            Trace(("cursor returned %d %s\n", status, db_strerror(status))) ;
         }
 
         if (status)
@@ -2066,4 +2066,3 @@ filter_store_value(db, code)
     SV *        RETVAL = &PL_sv_undef ;
     CODE:
         DBM_setFilter(db->filter_store_value, code) ;
-
index 9282c49..5d87068 100644 (file)
@@ -1,4 +1,5 @@
 # NeXT needs /usr/lib/libposix.a to load along with DB_File.so
+no strict 'vars';
 if ( $dlsrc eq "dl_next.xs" ) {
     @DynaLoader::dl_resolve_using = ( '/usr/lib/libposix.a' );
 }
index 774c219..b149268 100644 (file)
@@ -4,8 +4,8 @@ use strict ;
 use ExtUtils::MakeMaker 5.16 ;
 use Config ;
 
-die "DB_File needs Perl 5.8.3 or better. This is $]\n" 
-    if $] < 5.008003; 
+die "DB_File needs Perl 5.8.3 or better. This is $]\n"
+    if $] < 5.008003;
 
 my $VER_INFO ;
 my $LIB_DIR ;
@@ -41,7 +41,7 @@ $OS2 = "-DOS2" if $Config{'osname'} eq 'os2' ;
 my $WALL = '' ;
 #$WALL = ' -Wall ';
 
-# Only want ppport.h t to be used by DB_File.xs when not 
+# Only want ppport.h t to be used by DB_File.xs when not
 # building this module with the perl source distribution.
 my $CORE = $ENV{PERL_CORE} ? '' : '-D_NOT_CORE';
 
@@ -54,8 +54,8 @@ WriteMakefile(
         XSPROTOARG      => '-noprototypes',
         DEFINE          => "$CORE $OS2 $VER_INFO $COMPAT185 $WALL",
         OBJECT          => 'version$(OBJ_EXT) DB_File$(OBJ_EXT)',
-    ((ExtUtils::MakeMaker->VERSION() gt '6.30') 
-        ?  ('LICENSE'  => 'perl')         
+    ((ExtUtils::MakeMaker->VERSION() gt '6.30')
+        ?  ('LICENSE'  => 'perl')
         : ()
     ),
     (
@@ -64,9 +64,9 @@ WriteMakefile(
             AUTHOR       => 'Paul Marquess <pmqs@cpan.org>')
         : ()
     ),
-    
-    ($] < 5.008 || $] > 5.011) 
-        ? (INSTALLDIRS => 'site') 
+
+    ($] < 5.008 || $] > 5.011)
+        ? (INSTALLDIRS => 'site')
         : (INSTALLDIRS => 'perl'),
 
         #OPTIMIZE       => '-g',
@@ -77,13 +77,13 @@ WriteMakefile(
         'dist'          => { COMPRESS => 'gzip', SUFFIX => 'gz',
                              DIST_DEFAULT => 'MyDoubleCheck tardist'},
 
-     ( eval { ExtUtils::MakeMaker->VERSION(6.46) }  
+     ( eval { ExtUtils::MakeMaker->VERSION(6.46) }
         ? ( META_MERGE  => {
-    
+
                 "meta-spec" => { version => 2 },
-                
+
                 resources   => {
-                
+
                     bugtracker  => {
                         web     => 'https://github.com/pmqs/DB_File/issues'
                     },
@@ -94,10 +94,10 @@ WriteMakefile(
                         type    => 'git',
                         url     => 'git://github.com/pmqs/DB_File.git',
                         web     => 'https://github.com/pmqs/DB_File',
-                    },        
+                    },
                 },
-            } 
-            ) 
+            }
+            )
         : ()
     ),
 
@@ -159,16 +159,16 @@ if (eval {require ExtUtils::Constant; 1}) {
         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')
@@ -186,10 +186,10 @@ sub MY::libscan
     my $path = shift ;
 
     return undef
-        if $path =~ /(~|\.bak)$/ || 
+        if $path =~ /(~|\.bak)$/ ||
            $path =~ /^\..*\.swp$/ ;
 
-    return $path;    
+    return $path;
 }
 
 
@@ -202,27 +202,27 @@ MyDoubleCheck:
        grep "^#DBNAME.*" config.in) >/dev/null ||              \
            (echo config.in needs fixing ; exit 1)
        @echo config.in is ok
-       @echo 
+       @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
        @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
        @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
        @echo All files are OK for a release.
-       @echo 
+       @echo
 
 EOM
 
@@ -240,7 +240,7 @@ sub ParseCONFIG
 
     print "Parsing $CONFIG...\n" ;
 
-    # DBNAME & COMPAT185 are optional, so pretend they  have 
+    # DBNAME & COMPAT185 are optional, so pretend they  have
     # been parsed.
     delete $Parsed{'DBNAME'} ;
     delete $Parsed{'COMPAT185'} ;
@@ -270,16 +270,16 @@ sub ParseCONFIG
 
     # check parsed values
     my @missing = () ;
-    die "The following keys are missing from $CONFIG file: [@missing]\n" 
+    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'} && 
+    $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 ; 
+                $Info{'COMPAT185'} =~ /^\s*(on|true|1)\s*$/i ;
     my $PREFIX  = $Info{'PREFIX'} ;
     my $HASH    = $Info{'HASH'} ;
 
index d79a950..1fc28e3 100644 (file)
@@ -32,7 +32,7 @@ LIB   = /usr/local/BerkeleyDB/lib
 #    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. 
+#    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).
@@ -41,7 +41,7 @@ LIB   = /usr/local/BerkeleyDB/lib
 #    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 *));  
+#        int      (*prefix)      __P((const DBT *, const DBT *));
 #
 #    and like this in a more recent copy:
 #
@@ -54,7 +54,7 @@ LIB   = /usr/local/BerkeleyDB/lib
 #    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));      
+#        int      (*hash) __P((const void *, size_t));
 #
 #    newer like this:
 #
@@ -91,7 +91,7 @@ HASH  =       u_int32_t
 #    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
index c2842f6..e6ba7fd 100644 (file)
@@ -1,10 +1,10 @@
 #!/usr/bin/perl
 
-# Name:         dbinfo -- identify berkeley DB version used to create 
+# Name:         dbinfo -- identify berkeley DB version used to create
 #                         a database file
 #
 # Author:       Paul Marquess  <pmqs@cpan.org>
-# Version:      1.07 
+# Version:      1.07
 # Date          2nd April 2011
 #
 #     Copyright (c) 1998-2020 Paul Marquess. All rights reserved.
index 53703a0..75b2e36 100644 (file)
@@ -1 +1,2 @@
+no strict 'vars';
 $self->{LIBS} = [''];
index bb5ffa5..a2dc253 100644 (file)
@@ -1,3 +1,3 @@
 # Need to add an extra '-lc' to the end to work around a DYNIX/ptx bug
-
+no strict 'vars';
 $self->{LIBS} = ['-lm -lc'];
index 53703a0..75b2e36 100644 (file)
@@ -1 +1,2 @@
+no strict 'vars';
 $self->{LIBS} = [''];
index 53703a0..75b2e36 100644 (file)
@@ -1 +1,2 @@
+no strict 'vars';
 $self->{LIBS} = [''];
index 53703a0..75b2e36 100644 (file)
@@ -1 +1,2 @@
+no strict 'vars';
 $self->{LIBS} = [''];
index ff60440..0bcded6 100644 (file)
@@ -1,2 +1,3 @@
 # osr5 needs to explicitly link against libc to pull in some static symbols
+no strict 'vars';
 $self->{LIBS} = ['-ldb -lc'] if $Config{'osvers'} =~ '3\.2v5\.0\..' ;
index 86cfb0c..fc19e99 100644 (file)
@@ -3,7 +3,7 @@
 use warnings;
 use strict;
 use Config;
+
 BEGIN {
     if(-d "lib" && -f "TEST") {
         if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
@@ -29,7 +29,7 @@ EOM
     }
 }
 
-use DB_File; 
+use DB_File;
 use Fcntl;
 use File::Temp qw(tempdir) ;
 
@@ -41,7 +41,7 @@ sub ok
 {
     my $no = shift ;
     my $result = shift ;
+
     print "not " unless $result ;
     print "ok $no\n" ;
 }
@@ -84,7 +84,7 @@ sub lexical
 }
 
 sub docat
-{ 
+{
     my $file = shift;
     local $/ = undef ;
     open(CAT,$file) || die "Cannot open $file: $!";
@@ -92,20 +92,20 @@ sub docat
     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 
+    $data =~ s#\r\n#\n#g
         if $^O eq 'cygwin' ;
 
     return $data ;
@@ -123,7 +123,7 @@ sub safeUntie
 
 
 my $db185mode =  ($DB_File::db_version == 1 && ! $DB_File::db_185_compat) ;
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
+my $null_keys_allowed = ($DB_File::db_ver < 2.004010
                                 || $DB_File::db_ver >= 3.1 );
 
 my $TEMPDIR = tempdir( CLEANUP => 1 );
@@ -136,7 +136,7 @@ umask(0);
 
 # Check the interface to BTREEINFO
 
-my $dbh = new DB_File::BTREEINFO ;
+my $dbh = DB_File::BTREEINFO->new();
 ok(1, ! defined $dbh->{flags}) ;
 ok(2, ! defined $dbh->{cachesize}) ;
 ok(3, ! defined $dbh->{psize}) ;
@@ -311,11 +311,11 @@ ok(33, join(':',200..400) eq join(':',@foo) );
 
 # 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 
+
+# check that the value of the key 'x' has not been changed by the
 # previous test
 ok(35, $h{'x'} eq 'X' );
 
@@ -414,7 +414,7 @@ $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 
+# use seq to walk forwards through a file
 
 $status = $X->seq($key, $value, R_FIRST) ;
 ok(64, $status == 0 );
@@ -429,7 +429,7 @@ while (($status = $X->seq($key, $value, R_NEXT)) == 0)
 ok(65, $status == 1 );
 ok(66, $ok == 1 );
 
-# use seq to walk backwards through a file 
+# use seq to walk backwards through a file
 $status = $X->seq($key, $value, R_LAST) ;
 ok(67, $status == 0 );
 $previous = $key ;
@@ -480,7 +480,7 @@ undef $Y ;
 untie %h ;
 
 # Duplicate keys
-my $bt = new DB_File::BTREEINFO ;
+my $bt = DB_File::BTREEINFO->new();
 $bt->{flags} = R_DUP ;
 my ($YY, %hh);
 ok(74, $YY = tie(%hh, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $bt )) ;
@@ -519,7 +519,7 @@ 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 
+ok(83, keys %wall == 3 && $wall{'Larry'} == 1 && $wall{'Stone'} == 1
                 && $wall{'Brick'} == 2);
 
 undef $YY ;
@@ -531,53 +531,53 @@ unlink $Dfile;
 my $Dfile1 = "btree1" ;
 my $Dfile2 = "btree2" ;
 my $Dfile3 = "btree3" ;
-my $dbh1 = new DB_File::BTREEINFO ;
-$dbh1->{compare} = sub { 
+
+my $dbh1 = DB_File::BTREEINFO->new();
+$dbh1->{compare} = sub {
         no warnings 'numeric' ;
-        $_[0] <=> $_[1] } ; 
-my $dbh2 = new DB_File::BTREEINFO ;
+        $_[0] <=> $_[1] } ;
+
+my $dbh2 = DB_File::BTREEINFO->new();
 $dbh2->{compare} = sub { $_[0] cmp $_[1] } ;
-my $dbh3 = new DB_File::BTREEINFO ;
+
+my $dbh3 = DB_File::BTREEINFO->new();
 $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_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 (0 .. @$a - 1)
     {
         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]) );
@@ -646,27 +646,27 @@ unlink $Dfile1 ;
    @ISA=qw(DB_File);
    @EXPORT = @DB_File::EXPORT ;
 
-   sub STORE { 
+   sub STORE {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::STORE($key, $value * 2) ;
    }
 
-   sub FETCH { 
+   sub FETCH {
         my $self = shift ;
         my $key = shift ;
         $self->SUPER::FETCH($key) - 1 ;
    }
 
-   sub put { 
+   sub put {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::put($key, $value * 3) ;
    }
 
-   sub get { 
+   sub get {
         my $self = shift ;
         $self->SUPER::get($_[0], $_[1]) ;
         $_[1] -= 2 ;
@@ -685,7 +685,7 @@ EOM
 
     close FILE ;
 
-    BEGIN { push @INC, '.'; }    
+    BEGIN { push @INC, '.'; }
     eval 'use SubDB ; ';
     main::ok(91, $@ eq "") ;
     my %h ;
@@ -731,11 +731,11 @@ EOM
    {
        my($fk, $sk, $fv, $sv) = @_ ;
        return
-           $fetch_key eq $fk && $store_key eq $sk && 
+           $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 = $_ }) ;
@@ -760,15 +760,15 @@ EOM
    ok(106, checkOutput( "fred", "", "", "")) ;
 
    # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
+   my ($old_fk) = $db->filter_fetch_key
                         (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
+   my ($old_sk) = $db->filter_store_key
                         (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
+   my ($old_fv) = $db->filter_fetch_value
                         (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_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
@@ -825,7 +825,7 @@ EOM
    unlink $Dfile;
 }
 
-{    
+{
     # DBM Filter with a closure
 
     use warnings ;
@@ -843,8 +843,8 @@ EOM
         my $count = 0 ;
         my @kept = () ;
 
-        return sub { ++$count ; 
-                     push @kept, $_ ; 
+        return sub { ++$count ;
+                     push @kept, $_ ;
                      $result{$name} = "$name - $count: [@kept]" ;
                    }
     }
@@ -887,7 +887,7 @@ EOM
     undef $db ;
     untie %h;
     unlink $Dfile;
-}               
+}
 
 {
    # DBM Filter recursion detection
@@ -902,7 +902,7 @@ EOM
 
    eval '$h{1} = 1234' ;
    ok(146, $@ =~ /^recursion detected in filter_store_key at/ );
-   
+
    undef $db ;
    untie %h;
    unlink $Dfile;
@@ -915,7 +915,7 @@ EOM
 
   my $file = "xyzt" ;
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 1
     ###
@@ -936,7 +936,7 @@ EOM
     $DB_BTREE->{'compare'} = \&Compare ;
 
     unlink "tree" ;
-    tie %h, "DB_File", "tree", O_RDWR|O_CREAT, 0640, $DB_BTREE 
+    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
@@ -957,7 +957,7 @@ EOM
     untie %h ;
 
     unlink "tree" ;
-  }  
+  }
 
   delete $DB_BTREE->{'compare'} ;
 
@@ -966,9 +966,9 @@ mouse
 Smith
 Wall
 EOM
-   
+
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 2
     ###
@@ -981,13 +981,13 @@ EOM
 
     $filename = "tree" ;
     unlink $filename ;
+
     # Enable duplicate records
     $DB_BTREE->{'flags'} = R_DUP ;
-    tie %h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_BTREE 
+
+    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
@@ -1003,7 +1003,7 @@ EOM
     untie %h ;
 
     unlink $filename ;
-  }  
+  }
 
   ok(148, docat_del($file) eq ($db185mode ? <<'EOM' : <<'EOM') ) ;
 Smith -> John
@@ -1020,7 +1020,7 @@ mouse -> mickey
 EOM
 
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 3
     ###
@@ -1028,25 +1028,25 @@ EOM
     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 
+
+    $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 ;
@@ -1054,8 +1054,8 @@ EOM
          $status == 0 ;
          $status = $x->seq($key, $value, R_NEXT) )
       {  print "$key -> $value\n" }
+
+
     undef $x ;
     untie %h ;
   }
@@ -1076,7 +1076,7 @@ EOM
 
 
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 4
     ###
@@ -1084,17 +1084,17 @@ EOM
     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 
+
+    $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" ;
 
@@ -1107,10 +1107,10 @@ EOM
 
     @list = $x->get_dup("Smith") ;
     print "Smith => [@list]\n" ;
+
     @list = $x->get_dup("Dog") ;
-    print "Dog => [@list]\n" ; 
+    print "Dog => [@list]\n" ;
+
     undef $x ;
     untie %h ;
   }
@@ -1125,7 +1125,7 @@ Dog => []
 EOM
 
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 5
     ###
@@ -1133,23 +1133,23 @@ EOM
     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 
+
+    $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") ; 
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
     print "Larry Wall is $found there\n" ;
-    
-    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ; 
+
+    $found = ( $x->find_dup("Wall", "Harry") == 0 ? "" : "not") ;
     print "Harry Wall is $found there\n" ;
-    
+
     undef $x ;
     untie %h ;
   }
@@ -1160,7 +1160,7 @@ Harry Wall is not there
 EOM
 
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 6
     ###
@@ -1168,22 +1168,22 @@ EOM
     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 
+
+    $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") ; 
+    $found = ( $x->find_dup("Wall", "Larry") == 0 ? "" : "not") ;
     print "Larry Wall is $found there\n" ;
-    
+
     undef $x ;
     untie %h ;
 
@@ -1195,7 +1195,7 @@ Larry Wall is not there
 EOM
 
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     # BTREE example 7
     ###
@@ -1221,22 +1221,22 @@ EOM
 
     $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{'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" ;
@@ -1269,7 +1269,7 @@ EOM
     # Bug ID 20001013.009
     #
     # test that $hash{KEY} = undef doesn't produce the warning
-    #     Use of uninitialized value in null operation 
+    #     Use of uninitialized value in null operation
     use warnings ;
     use strict ;
     use DB_File ;
@@ -1278,7 +1278,7 @@ EOM
     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;
@@ -1298,7 +1298,7 @@ EOM
     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 = (); ;
@@ -1351,7 +1351,7 @@ EOM
 
 {
     # now an error to pass 'compare' a non-code reference
-    my $dbh = new DB_File::BTREEINFO ;
+    my $dbh = DB_File::BTREEINFO->new();
 
     eval { $dbh->{compare} = 2 };
     ok(162, $@ =~ /^Key 'compare' not associated with a code reference at/);
@@ -1366,10 +1366,10 @@ EOM
 #    # recursion detection in btree
 #    my %hash ;
 #    unlink $Dfile;
-#    my $dbh = new DB_File::BTREEINFO ;
+#    my $dbh = DB_File::BTREEINFO->new();
 #    $dbh->{compare} = sub { $hash{3} = 4 ; length $_[0] } ;
-# 
-# 
+#
+#
 #    my (%h);
 #    ok(164, tie(%hash, 'DB_File',$Dfile, O_RDWR|O_CREAT, 0640, $dbh ) );
 #
@@ -1394,14 +1394,14 @@ ok(165,1);
     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 $dbh1 = DB_File::BTREEINFO->new();
+    $dbh1->{compare} = sub { ++ $h1_count ; $_[0] cmp $_[1] } ;
+
+    my $dbh2 = DB_File::BTREEINFO->new();
+    $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 ) );
@@ -1457,7 +1457,7 @@ ok(165,1);
    ok(175, $h{"fred"} eq "joe");
 
    ok(176, $db->FIRSTKEY() eq "fred") ;
-   
+
    eval { my @r= grep { $h{$_} } (1, 2, 3) };
    ok (177, ! $@);
 
@@ -1518,7 +1518,7 @@ ok(165,1);
     # 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
 
 
@@ -1543,7 +1543,7 @@ ok(165,1);
         $db->put(substr($key,0), $value) ;
     }
 
-    ok 189, $warned eq '' 
+    ok 189, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # db-put with substr of value
@@ -1556,7 +1556,7 @@ ok(165,1);
         $db->put($key, substr($value,0)) ;
     }
 
-    ok 190, $warned eq '' 
+    ok 190, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied hash is not a problem, but check anyway
@@ -1570,7 +1570,7 @@ ok(165,1);
         $h{substr($key,0)} = $value ;
     }
 
-    ok 191, $warned eq '' 
+    ok 191, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied hash is not a problem, but check anyway
@@ -1584,7 +1584,7 @@ ok(165,1);
         $h{$key} = substr($value,0) ;
     }
 
-    ok 192, $warned eq '' 
+    ok 192, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     my %bad = () ;
@@ -1594,7 +1594,7 @@ ok(165,1);
          $status = $db->seq($key, $value, R_NEXT ) ) {
 
         #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
+        if (defined $remember{$key} && defined $value &&
              $remember{$key} eq $value) {
             delete $remember{$key} ;
         }
@@ -1602,7 +1602,7 @@ ok(165,1);
             $bad{$key} = $value ;
         }
     }
-    
+
     ok 193, keys %bad == 0 ;
     ok 194, keys %remember == 0 ;
 
@@ -1610,11 +1610,11 @@ ok(165,1);
     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 
+    # Berkeley DB undef key is bron between versions 2.3.16 and
     my $value = 'fred';
     $warned = '';
     $db->put(undef, $value) ;
-    ok 195, $warned eq '' 
+    ok 195, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1623,7 +1623,7 @@ ok(165,1);
     $value = '' ;
     $db->get(undef, $value) ;
     ok 196, $no_NULL || $value eq 'fred' or print "# got [$value]\n" ;
-    ok 197, $warned eq '' 
+    ok 197, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1658,7 +1658,7 @@ ok(165,1);
 #   ok(204, $db->get($k, $v, R_CURSOR)) ;
 #
 #   ok(205, keys %h == 1) ;
-#   
+#
 #   undef $db ;
 #   untie %h;
 #   unlink $Dfile;
index 79ffe93..cc10bfc 100644 (file)
@@ -1,10 +1,10 @@
-#!./perl 
+#!./perl
 
 use warnings;
 use strict;
 use Config;
 use File::Temp qw(tempdir) ;
+
 BEGIN {
     if(-d "lib" && -f "TEST") {
         if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
@@ -14,7 +14,7 @@ BEGIN {
     }
 }
 
-use DB_File; 
+use DB_File;
 use Fcntl;
 
 print "1..166\n";
@@ -25,7 +25,7 @@ sub ok
 {
     my $no = shift ;
     my $result = shift ;
+
     print "not " unless $result ;
     print "ok $no\n" ;
 
@@ -55,7 +55,7 @@ sub ok
 }
 
 sub docat_del
-{ 
+{
     my $file = shift;
     local $/ = undef;
     open(CAT,$file) || die "Cannot open $file: $!";
@@ -64,12 +64,12 @@ sub docat_del
     $result = normalise($result) ;
     unlink $file ;
     return $result;
-}   
+}
 
 sub normalise
 {
     my $data = shift ;
-    $data =~ s#\r\n#\n#g 
+    $data =~ s#\r\n#\n#g
         if $^O eq 'cygwin' ;
     return $data ;
 }
@@ -88,7 +88,7 @@ chdir $TEMPDIR;
 
 my $Dfile = "dbhash.tmp";
 my $Dfile2 = "dbhash2.tmp";
-my $null_keys_allowed = ($DB_File::db_ver < 2.004010 
+my $null_keys_allowed = ($DB_File::db_ver < 2.004010
                                 || $DB_File::db_ver >= 3.1 );
 
 unlink $Dfile;
@@ -97,7 +97,7 @@ umask(0);
 
 # Check the interface to HASHINFO
 
-my $dbh = new DB_File::HASHINFO ;
+my $dbh = DB_File::HASHINFO->new();
 
 ok(1, ! defined $dbh->{bsize}) ;
 ok(2, ! defined $dbh->{ffactor}) ;
@@ -268,11 +268,11 @@ ok(30, join(':',200..400) eq join(':',@foo) );
 
 # 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 
+
+# check that the value of the key 'x' has not been changed by the
 # previous test
 ok(32, $h{'x'} eq 'X' );
 
@@ -383,7 +383,7 @@ untie %h ;
     # check ability to override the default hashing
     my %x ;
     my $filename = "xyz" ;
-    my $hi = new DB_File::HASHINFO ;
+    my $hi = DB_File::HASHINFO->new();
     $::count = 0 ;
     $hi->{hash} = sub { ++$::count ; length $_[0] } ;
     ok(49, tie %x, 'DB_File', $filename, O_RDWR|O_CREAT, 0640, $hi ) ;
@@ -426,27 +426,27 @@ untie %h ;
    @ISA=qw(DB_File);
    @EXPORT = @DB_File::EXPORT ;
 
-   sub STORE { 
+   sub STORE {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::STORE($key, $value * 2) ;
    }
 
-   sub FETCH { 
+   sub FETCH {
         my $self = shift ;
         my $key = shift ;
         $self->SUPER::FETCH($key) - 1 ;
    }
 
-   sub put { 
+   sub put {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::put($key, $value * 3) ;
    }
 
-   sub get { 
+   sub get {
         my $self = shift ;
         $self->SUPER::get($_[0], $_[1]) ;
         $_[1] -= 2 ;
@@ -465,7 +465,7 @@ EOM
 
     close FILE ;
 
-    BEGIN { push @INC, '.'; }             
+    BEGIN { push @INC, '.'; }
     eval 'use SubDB ; ';
     main::ok(53, $@ eq "") ;
     my %h ;
@@ -512,23 +512,23 @@ EOM
        no warnings 'uninitialized';
        my($fk, $sk, $fv, $sv) = @_ ;
 
-       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n" 
+       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n"
            if $fetch_key ne $fk ;
-       print "# Fetch Value : expected '$fv' got '$fetch_value'\n" 
+       print "# Fetch Value : expected '$fv' got '$fetch_value'\n"
            if $fetch_value ne $fv ;
-       print "# Store Key   : expected '$sk' got '$store_key'\n" 
+       print "# Store Key   : expected '$sk' got '$store_key'\n"
            if $store_key ne $sk ;
-       print "# Store Value : expected '$sv' got '$store_value'\n" 
+       print "# Store Value : expected '$sv' got '$store_value'\n"
            if $store_value ne $sv ;
-       print "# \$_          : expected 'original' got '$_'\n" 
+       print "# \$_          : expected 'original' got '$_'\n"
            if $_ ne 'original' ;
 
        return
-           $fetch_key   eq $fk && $store_key   eq $sk && 
+           $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 = $_ }) ;
@@ -557,15 +557,15 @@ EOM
    ok(70, checkOutput( "fred", "fred", "joe", "")) ;
 
    # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
+   my ($old_fk) = $db->filter_fetch_key
                         (sub { $_ = uc $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
+   my ($old_sk) = $db->filter_store_key
                         (sub { $_ = lc $_ ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
+   my ($old_fv) = $db->filter_fetch_value
                         (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_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
@@ -579,7 +579,7 @@ EOM
    ($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 
+   ok(75, $k eq "FRED") or
     print "# k [$k]\n" ;
    ok(76, $v eq "[Jxe]") ;
    #                   fk   sk     fv    sv
@@ -634,7 +634,7 @@ EOM
    unlink $Dfile;
 }
 
-{    
+{
     # DBM Filter with a closure
 
     use warnings ;
@@ -652,8 +652,8 @@ EOM
         my $count = 0 ;
         my @kept = () ;
 
-        return sub { ++$count ; 
-                     push @kept, $_ ; 
+        return sub { ++$count ;
+                     push @kept, $_ ;
                      $result{$name} = "$name - $count: [@kept]" ;
                    }
     }
@@ -696,7 +696,7 @@ EOM
     undef $db ;
     untie %h;
     unlink $Dfile;
-}               
+}
 
 {
    # DBM Filter recursion detection
@@ -711,7 +711,7 @@ EOM
 
    eval '$h{1} = 1234' ;
    ok(116, $@ =~ /^recursion detected in filter_store_key at/ );
-   
+
    undef $db ;
    untie %h;
    unlink $Dfile;
@@ -723,7 +723,7 @@ EOM
 
   my $file = "xyzt" ;
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     use warnings FATAL => qw(all);
     use strict ;
@@ -731,7 +731,7 @@ EOM
     our (%h, $k, $v);
 
     unlink "fruit" ;
-    tie %h, "DB_File", "fruit", O_RDWR|O_CREAT, 0640, $DB_HASH 
+    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
@@ -753,7 +753,7 @@ EOM
     untie %h ;
 
     unlink "fruit" ;
-  }  
+  }
 
   ok(117, docat_del($file) eq <<'EOM') ;
 Banana Exists
@@ -762,14 +762,14 @@ 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 of uninitialized value in null operation
     use warnings ;
     use strict ;
     use DB_File ;
@@ -778,7 +778,7 @@ EOM
     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 "") ;
@@ -797,7 +797,7 @@ EOM
     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 "") ;
@@ -849,7 +849,7 @@ EOM
 
 {
     # now an error to pass 'hash' a non-code reference
-    my $dbh = new DB_File::HASHINFO ;
+    my $dbh = DB_File::HASHINFO->new();
 
     eval { $dbh->{hash} = 2 };
     ok(126, $@ =~ /^Key 'hash' not associated with a code reference at/);
@@ -862,10 +862,10 @@ EOM
 #    my %hash ;
 #    my $Dfile = "xxx.db";
 #    unlink $Dfile;
-#    my $dbh = new DB_File::HASHINFO ;
+#    my $dbh = DB_File::HASHINFO->new();
 #    $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;
@@ -890,14 +890,14 @@ EOM
     my $h1_count = 0;
     my $h2_count = 0;
     unlink $Dfile, $Dfile2;
-    my $dbh1 = new DB_File::HASHINFO ;
+    my $dbh1 = DB_File::HASHINFO->new();
     $dbh1->{hash} = sub { ++ $h1_count ; length $_[0] } ;
 
-    my $dbh2 = new DB_File::HASHINFO ;
+    my $dbh2 = DB_File::HASHINFO->new();
     $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 ) );
@@ -919,9 +919,9 @@ EOM
 }
 
 {
-    # Passing undef for flags and/or mode when calling tie could cause 
+    # 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 };
@@ -981,7 +981,7 @@ EOM
    ok(139, $h{"fred"} eq "joe");
 
    ok(140, $db->FIRSTKEY() eq "fred") ;
-   
+
    eval { my @r= grep { $h{$_} } (1, 2, 3) };
    ok (141, ! $@);
 
@@ -1041,7 +1041,7 @@ EOM
     # 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
 
 
@@ -1066,7 +1066,7 @@ EOM
         $db->put(substr($key,0), $value) ;
     }
 
-    ok 153, $warned eq '' 
+    ok 153, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # db-put with substr of value
@@ -1079,7 +1079,7 @@ EOM
         $db->put($key, substr($value,0)) ;
     }
 
-    ok 154, $warned eq '' 
+    ok 154, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied hash is not a problem, but check anyway
@@ -1093,7 +1093,7 @@ EOM
         $h{substr($key,0)} = $value ;
     }
 
-    ok 155, $warned eq '' 
+    ok 155, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied hash is not a problem, but check anyway
@@ -1107,7 +1107,7 @@ EOM
         $h{$key} = substr($value,0) ;
     }
 
-    ok 156, $warned eq '' 
+    ok 156, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     my %bad = () ;
@@ -1117,7 +1117,7 @@ EOM
          $status = $db->seq(substr($key,0), substr($value,0), R_NEXT ) ) {
 
         #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
+        if (defined $remember{$key} && defined $value &&
              $remember{$key} eq $value) {
             delete $remember{$key} ;
         }
@@ -1125,7 +1125,7 @@ EOM
             $bad{$key} = $value ;
         }
     }
-    
+
     ok 157, keys %bad == 0 ;
     ok 158, keys %remember == 0 ;
 
@@ -1137,7 +1137,7 @@ EOM
     my $value = 'fred';
     $warned = '';
     $db->put(undef, $value) ;
-    ok 159, $warned eq '' 
+    ok 159, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1146,7 +1146,7 @@ EOM
     $value = '' ;
     $db->get(undef, $value) ;
     ok 160, $no_NULL || $value eq 'fred' or print "# got [$value]\n" ;
-    ok 161, $warned eq '' 
+    ok 161, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1205,7 +1205,7 @@ EOM
          $status = $db->seq($key, $value, R_NEXT ) ) {
 
         #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
+        if (defined $remember{$key} && defined $value &&
              $remember{$key} eq $value) {
             delete $remember{$key} ;
         }
@@ -1213,7 +1213,7 @@ EOM
             $bad{$key} = $value ;
         }
     }
-    
+
     ok 164, $_ eq 'fred';
     ok 165, keys %bad == 0 ;
     ok 166, keys %remember == 0 ;
index 08a89ff..4b80e93 100644 (file)
@@ -2,7 +2,7 @@
 
 use strict;
 use Config;
+
 BEGIN {
     if(-d "lib" && -f "TEST") {
         if ($Config{'extensions'} !~ /\bDB_File\b/ ) {
@@ -12,7 +12,7 @@ BEGIN {
     }
 }
 
-use DB_File; 
+use DB_File;
 use Fcntl;
 use File::Temp qw(tempdir) ;
 
@@ -25,7 +25,7 @@ our ($dbh, $Dfile, $bad_ones, $FA);
     sub try::TIEARRAY { bless [], "try" }
     sub try::FETCHSIZE { $FA = 1 }
     $FA = 0 ;
-    my @a ; 
+    my @a ;
     tie @a, 'try' ;
     my $a = @a ;
 }
@@ -76,12 +76,12 @@ sub docat
 }
 
 sub docat_del
-{ 
+{
     my $file = shift;
     my $result = docat($file);
     unlink $file ;
     return $result;
-}   
+}
 
 sub safeUntie
 {
@@ -114,7 +114,7 @@ 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). 
+# 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
@@ -129,25 +129,25 @@ sub normalise
 {
     return unless $^O eq 'cygwin' ;
     foreach (@_)
-      { s#\r\n#\n#g }     
+      { s#\r\n#\n#g }
 }
 
-BEGIN 
-{ 
-    { 
-        local $SIG{__DIE__} ; 
-        eval { require Data::Dumper ; import Data::Dumper } ; 
+BEGIN
+{
+    {
+        local $SIG{__DIE__} ;
+        eval { require Data::Dumper; Data::Dumper->import(); } ;
     }
+
     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";   
+print "1..$total_tests\n";
 
 my $TEMPDIR = tempdir( CLEANUP => 1 );
 chdir $TEMPDIR;
@@ -159,7 +159,7 @@ umask(0);
 
 # Check the interface to RECNOINFO
 
-$dbh = new DB_File::RECNOINFO ;
+$dbh = DB_File::RECNOINFO->new();
 ok(1, ! defined $dbh->{bval}) ;
 ok(2, ! defined $dbh->{cachesize}) ;
 ok(3, ! defined $dbh->{psize}) ;
@@ -297,7 +297,7 @@ my $ok = 1 ;
 my $j = 0 ;
 foreach (@data)
 {
-   $ok = 0, last if $_ ne $h[$j ++] ; 
+   $ok = 0, last if $_ ne $h[$j ++] ;
 }
 ok(52, $ok );
 
@@ -328,7 +328,7 @@ unlink $Dfile;
     # Check bval defaults to \n
 
     my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
+    my $dbh = DB_File::RECNOINFO->new();
     ok(59, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
     $h[0] = "abc" ;
     $h[1] = "def" ;
@@ -343,7 +343,7 @@ unlink $Dfile;
     # Change bval
 
     my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
+    my $dbh = DB_File::RECNOINFO->new();
     $dbh->{bval} = "-" ;
     ok(62, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
     $h[0] = "abc" ;
@@ -361,7 +361,7 @@ unlink $Dfile;
     # Check R_FIXEDLEN with default bval (space)
 
     my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
+    my $dbh = DB_File::RECNOINFO->new();
     $dbh->{flags} = R_FIXEDLEN ;
     $dbh->{reclen} = 5 ;
     ok(65, tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $dbh ) ;
@@ -380,7 +380,7 @@ unlink $Dfile;
     # Check R_FIXEDLEN with user-defined bval
 
     my @h = () ;
-    my $dbh = new DB_File::RECNOINFO ;
+    my $dbh = DB_File::RECNOINFO->new();
     $dbh->{flags} = R_FIXEDLEN ;
     $dbh->{bval} = "-" ;
     $dbh->{reclen} = 5 ;
@@ -428,27 +428,27 @@ unlink $Dfile;
    @ISA=qw(DB_File);
    @EXPORT = @DB_File::EXPORT ;
 
-   sub STORE { 
+   sub STORE {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::STORE($key, $value * 2) ;
    }
 
-   sub FETCH { 
+   sub FETCH {
         my $self = shift ;
         my $key = shift ;
         $self->SUPER::FETCH($key) - 1 ;
    }
 
-   sub put { 
+   sub put {
         my $self = shift ;
         my $key = shift ;
         my $value = shift ;
         $self->SUPER::put($key, $value * 3) ;
    }
 
-   sub get { 
+   sub get {
         my $self = shift ;
         $self->SUPER::get($_[0], $_[1]) ;
         $_[1] -= 2 ;
@@ -467,7 +467,7 @@ EOM
 
     close FILE  or die "Could not close: $!";
 
-    BEGIN { push @INC, '.'; } 
+    BEGIN { push @INC, '.'; }
     eval 'use SubDB ; ';
     main::ok(72, $@ eq "") ;
     my @h ;
@@ -520,11 +520,11 @@ EOM
 
     # $# sets array to same length
     $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ;
-    ok(87, $self) 
+    ok(87, $self)
         or warn "# $DB_File::Error\n";
     if ($FA)
       { $#h = 3 }
-    else 
+    else
       { $self->STORESIZE(4) }
     ok(88, $FA ? $#h == 3 : $self->length() == 4) ;
     undef $self ;
@@ -536,7 +536,7 @@ EOM
     ok(91, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
     if ($FA)
       { $#h = 6 }
-    else 
+    else
       { $self->STORESIZE(7) }
     ok(92, $FA ? $#h == 6 : $self->length() == 7) ;
     undef $self ;
@@ -548,7 +548,7 @@ EOM
     ok(95, $self = tie @h, 'DB_File', $Dfile, O_RDWR, 0640, $DB_RECNO ) ;
     if ($FA)
       { $#h = 2 }
-    else 
+    else
       { $self->STORESIZE(3) }
     ok(96, $FA ? $#h == 2 : $self->length() == 3) ;
     undef $self ;
@@ -573,23 +573,23 @@ EOM
    {
        my($fk, $sk, $fv, $sv) = @_ ;
 
-       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n" 
+       print "# Fetch Key   : expected '$fk' got '$fetch_key'\n"
            if $fetch_key ne $fk ;
-       print "# Fetch Value : expected '$fv' got '$fetch_value'\n" 
+       print "# Fetch Value : expected '$fv' got '$fetch_value'\n"
            if $fetch_value ne $fv ;
-       print "# Store Key   : expected '$sk' got '$store_key'\n" 
+       print "# Store Key   : expected '$sk' got '$store_key'\n"
            if $store_key ne $sk ;
-       print "# Store Value : expected '$sv' got '$store_value'\n" 
+       print "# Store Value : expected '$sv' got '$store_value'\n"
            if $store_value ne $sv ;
-       print "# \$_          : expected 'original' got '$_'\n" 
+       print "# \$_          : expected 'original' got '$_'\n"
            if $_ ne 'original' ;
 
        return
-           $fetch_key   eq $fk && $store_key   eq $sk && 
+           $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 = $_ }) ;
@@ -614,15 +614,15 @@ EOM
    ok(104, checkOutput( 0, "", "", "")) ;
 
    # replace the filters, but remember the previous set
-   my ($old_fk) = $db->filter_fetch_key   
+   my ($old_fk) = $db->filter_fetch_key
                         (sub { ++ $_ ; $fetch_key = $_ }) ;
-   my ($old_sk) = $db->filter_store_key   
+   my ($old_sk) = $db->filter_store_key
                         (sub { $_ *= 2 ; $store_key = $_ }) ;
-   my ($old_fv) = $db->filter_fetch_value 
+   my ($old_fv) = $db->filter_fetch_value
                         (sub { $_ = "[$_]"; $fetch_value = $_ }) ;
-   my ($old_sv) = $db->filter_store_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
@@ -637,7 +637,7 @@ EOM
    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);
@@ -679,7 +679,7 @@ EOM
    unlink $Dfile;
 }
 
-{    
+{
     # DBM Filter with a closure
 
     use warnings ;
@@ -697,8 +697,8 @@ EOM
         my $count = 0 ;
         my @kept = () ;
 
-        return sub { ++$count ; 
-                     push @kept, $_ ; 
+        return sub { ++$count ;
+                     push @kept, $_ ;
                      $result{$name} = "$name - $count: [@kept]" ;
                    }
     }
@@ -741,7 +741,7 @@ EOM
     undef $db ;
     ok(144, safeUntie \@h);
     unlink $Dfile;
-}               
+}
 
 {
    # DBM Filter recursion detection
@@ -756,7 +756,7 @@ EOM
 
    eval '$h[1] = 1234' ;
    ok(146, $@ =~ /^recursion detected in filter_store_key at/ );
-   
+
    undef $db ;
    ok(147, safeUntie \@h);
    unlink $Dfile;
@@ -768,7 +768,7 @@ EOM
 
   my $file = "xyzt" ;
   {
-    my $redirect = new Redirect $file ;
+    my $redirect = Redirect->new( $file );
 
     use warnings FATAL => qw(all);
     use strict ;
@@ -778,7 +778,7 @@ EOM
     unlink $filename ;
 
     my @h ;
-    my $x = tie @h, "DB_File", $filename, O_RDWR|O_CREAT, 0640, $DB_RECNO 
+    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
@@ -786,7 +786,7 @@ EOM
     $h[1] = "blue" ;
     $h[2] = "yellow" ;
 
-    $FA ? push @h, "green", "black" 
+    $FA ? push @h, "green", "black"
         : $x->push("green", "black") ;
 
     my $elements = $FA ? scalar @h : $x->length ;
@@ -795,7 +795,7 @@ EOM
     my $last = $FA ? pop @h : $x->pop ;
     print "popped $last\n" ;
 
-    $FA ? unshift @h, "white" 
+    $FA ? unshift @h, "white"
         : $x->unshift("white") ;
     my $first = $FA ? shift @h : $x->shift ;
     print "shifted $first\n" ;
@@ -811,7 +811,7 @@ EOM
     untie @h ;
 
     unlink $filename ;
-  }  
+  }
 
   ok(148, docat_del($file) eq <<'EOM') ;
 The array contains 5 entries
@@ -824,21 +824,21 @@ EOM
 
   my $save_output = "xyzt" ;
   {
-    my $redirect = new Redirect $save_output ;
+    my $redirect = Redirect->new( $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 
+    $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" ;
@@ -846,12 +846,12 @@ EOM
     $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.  
+    # elements in the array.
 
     print "\nORIGINAL\n" ;
     foreach $i (0 .. $H->length - 1) {
@@ -887,16 +887,16 @@ EOM
     # 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 ; 
+    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 ;    
+    untie @h ;
 
     unlink $file ;
-  }  
+  }
 
   ok(149, docat_del($save_output) eq <<'EOM') ;
 
@@ -926,14 +926,14 @@ REVERSE again
 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 of uninitialized value in null operation
     use warnings ;
     use strict ;
     use DB_File ;
@@ -942,8 +942,8 @@ EOM
     my @h ;
     my $a = "";
     local $SIG{__WARN__} = sub {$a = $_[0]} ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
+
+    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 "") ;
@@ -962,8 +962,8 @@ EOM
 
     unlink $Dfile;
     my @h ;
-    
-    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
+
+    tie @h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO
         or die "Can't open file: $!\n" ;
     @h = (); ;
     ok(152, $a eq "") ;
@@ -1064,7 +1064,7 @@ EOM
     # 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
 
 
@@ -1090,7 +1090,7 @@ EOM
         $db->put(substr($key,0, 1), $value) ;
     }
 
-    ok 170, $warned eq '' 
+    ok 170, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # db-put with substr of value
@@ -1103,7 +1103,7 @@ EOM
         $db->put($ix, substr($value,0)) ;
     }
 
-    ok 171, $warned eq '' 
+    ok 171, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied array is not a problem, but check anyway
@@ -1117,7 +1117,7 @@ EOM
         $h[substr($key,0,1)] = $value ;
     }
 
-    ok 172, $warned eq '' 
+    ok 172, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     # via the tied array is not a problem, but check anyway
@@ -1131,7 +1131,7 @@ EOM
         $h[$ix] = substr($value,0) ;
     }
 
-    ok 173, $warned eq '' 
+    ok 173, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
 
     my %bad = () ;
@@ -1141,7 +1141,7 @@ EOM
          $status = $db->seq($key, $value, R_NEXT ) ) {
 
         #print "# key [$key] value [$value]\n" ;
-        if (defined $remember{$key} && defined $value && 
+        if (defined $remember{$key} && defined $value &&
              $remember{$key} eq $value) {
             delete $remember{$key} ;
         }
@@ -1149,7 +1149,7 @@ EOM
             $bad{$key} = $value ;
         }
     }
-    
+
     ok 174, keys %bad == 0 ;
     ok 175, keys %remember == 0 ;
 
@@ -1162,7 +1162,7 @@ EOM
     $status = $db->put(undef, $value) ;
     ok 176, $status == 0
       or print "# put failed - status $status\n";
-    ok 177, $warned eq '' 
+    ok 177, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1173,7 +1173,7 @@ EOM
         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 '' 
+    ok 181, $warned eq ''
       or print "# Caught warning [$warned]\n" ;
     $warned = '';
 
@@ -1200,8 +1200,8 @@ exit unless $FA ;
 
     unlink $Dfile;
     my @tied ;
-    
-    tie @tied, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO 
+
+    tie @tied, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0664, $DB_RECNO
         or die "Can't open file: $!\n" ;
 
     # uninitialized offset
@@ -1261,15 +1261,15 @@ exit unless $FA ;
     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,
@@ -1309,7 +1309,7 @@ my @tests = ([ [ 'falsely', 'dinosaur', 'remedy', 'commotion',
                undef, undef,
                [ 'otrb', 'stje', 'ixrpw', 'vxfx', 'lhhf' ],
                'scalar' ],
-             
+
              [ [ 'riheb' ], -8, undef, [], 'void' ],
 
              [ [ 'uft', 'qnxs', '' ],
@@ -1355,7 +1355,7 @@ else {
     ok($testnum++, not $failed);
 }
 
-die "testnum ($testnum) != total_tests ($total_tests) + 1" 
+die "testnum ($testnum) != total_tests ($total_tests) + 1"
     if $testnum != $total_tests + 1;
 
 exit ;
@@ -1363,21 +1363,21 @@ 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) = @_;
@@ -1385,20 +1385,20 @@ sub test_splice {
     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] };
@@ -1491,7 +1491,7 @@ sub test_splice {
     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;
@@ -1506,10 +1506,10 @@ sub test_splice {
             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: $!";
@@ -1532,10 +1532,10 @@ sub test_splice {
 #   reference to second list
 #
 # Returns true iff they differ.  Only works for lists of (string or
-# undef). 
-# 
+# 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;
@@ -1555,15 +1555,15 @@ sub list_diff {
         }
     }
     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>;
@@ -1596,5 +1596,3 @@ sub rand_word {
     }
     return $r;
 }
-
-
index f9bce95..95bffa0 100644 (file)
@@ -1,4 +1,4 @@
-#!./perl 
+#!./perl
 
 use warnings;
 use strict;
index ecf73de..7df0d5a 100644 (file)
@@ -1,6 +1,6 @@
-/* 
+/*
 
- version.c -- Perl 5 interface to Berkeley DB 
+ version.c -- Perl 5 interface to Berkeley DB
 
  written by Paul Marquess <pmqs@cpan.org>
  last modified 2nd Jan 2002
@@ -23,7 +23,7 @@
 */
 
 #define PERL_NO_GET_CONTEXT
-#include "EXTERN.h"  
+#include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
@@ -36,9 +36,9 @@ __getBerkeleyDBInfo(void)
 __getBerkeleyDBInfo()
 #endif
 {
-#ifdef dTHX     
+#ifdef dTHX
     dTHX;
-#endif    
+#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) ;
@@ -53,22 +53,22 @@ __getBerkeleyDBInfo()
                 /* || 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, 
+                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) ; 
+        sv_setpv(version_sv, buffer) ;
         sprintf(buffer, "%d.%03d%03d", Major, Minor, Patch) ;
-        sv_setpv(ver_sv, buffer) ; 
+        sv_setpv(ver_sv, buffer) ;
     }
+
 #else /* ! DB_VERSION_MAJOR */
     sv_setiv(version_sv, 1) ;
     sv_setiv(ver_sv, 1) ;