DB_File 1.807

From: "Paul Marquess" <Paul.Marquess@btinternet.com>
Message-ID: <AIEAJICLCBDNAAOLLOKLOENMPAAA.Paul.Marquess@btinternet.com>

p4raw-id: //depot/perl@21615

6 files changed, 68 insertions, 42 deletions

diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index c9f33b2f9f..848d26a853 100644
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -1,4 +1,11 @@
 
+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.
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index fa94a39e45..54e0b527b3 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,10 +1,10 @@
 # DB_File.pm -- Perl 5 interface to Berkeley DB 
 #
-# written by Paul Marquess (Paul.Marquess@btinternet.com)
+# written by Paul Marquess (pmqs@cpan.org)
 # last modified 22nd October 2002
-# version 1.806
+# version 1.807
 #
-#     Copyright (c) 1995-2002 Paul Marquess. All rights reserved.
+#     Copyright (c) 1995-2003 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.
 
@@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice_end_array);
 use Carp;
 
 
-$VERSION = "1.806" ;
+$VERSION = "1.807" ;
 
 {
     local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
@@ -2252,7 +2252,7 @@ compile properly on IRIX 5.3.
 
 =head1 COPYRIGHT
 
-Copyright (c) 1995-2002 Paul Marquess. All rights reserved. This program
+Copyright (c) 1995-2003 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.
 
@@ -2284,7 +2284,7 @@ L<dbmfilter>
 =head1 AUTHOR
 
 The DB_File interface was written by Paul Marquess
-E<lt>Paul.Marquess@btinternet.comE<gt>.
+E<lt>pmqs@cpan.org<gt>.
 Questions about the DB system itself may be addressed to
 E<lt>db@sleepycat.com<gt>.
 
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index aa5d135147..3f097de8dd 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -2,13 +2,13 @@
 
  DB_File.xs -- Perl 5 interface to Berkeley DB 
 
- written by Paul Marquess <Paul.Marquess@btinternet.com>
+ written by Paul Marquess <pmqs@cpan.org>
  last modified 22nd October 2002
- version 1.806
+ version 1.807
 
  All comments/suggestions/problems are welcome
 
-     Copyright (c) 1995-2002 Paul Marquess. All rights reserved.
+     Copyright (c) 1995-2003 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.
 
@@ -106,6 +106,7 @@
                 Support for 4.1.X added.
                 Filter code can now cope with read-only $_
         1.806 - recursion detection beefed up.
+        1.807 - no change
 
 */
 
diff --git a/ext/DB_File/dbinfo b/ext/DB_File/dbinfo
index af2c45facf..421d36c626 100644
--- a/ext/DB_File/dbinfo
+++ b/ext/DB_File/dbinfo
@@ -4,10 +4,10 @@
 #			  a database file
 #
 # Author:	Paul Marquess  <Paul.Marquess@btinternet.com>
-# Version: 	1.03 
-# Date		17th September 2000
+# Version: 	1.05 
+# Date		1sh November 2003
 #
-#     Copyright (c) 1998-2002 Paul Marquess. All rights reserved.
+#     Copyright (c) 1998-2003 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.
 
@@ -22,39 +22,39 @@ my %Data =
 			  Type 	   => "Btree",
 			  Versions => 
 				{
-				  1	=> "Unknown (older than 1.71)",
-				  2	=> "Unknown (older than 1.71)",
-				  3	=> "1.71 -> 1.85, 1.86",
-				  4	=> "Unknown",
-				  5	=> "2.0.0 -> 2.3.0",
-				  6	=> "2.3.1 -> 2.7.7",
-				  7	=> "3.0.x",
-				  8	=> "3.1.x -> 4.0.x",
-				  9	=> "4.1.x or greater",
+				  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 => 	{
 			  Type     => "Hash",
 			  Versions =>
 				{
-				  1	=> "Unknown (older than 1.71)",
-        			  2     => "1.71 -> 1.85",
-        			  3     => "1.86",
-        			  4     => "2.0.0 -> 2.1.0",
-        			  5     => "2.2.6 -> 2.7.7",
-        			  6     => "3.0.x",
-				  7	=> "3.1.x -> 4.0.x",
-				  8	=> "4.1.x or greater",
+				  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"],
 				}
 			},
 	0x042253 => 	{
 			  Type     => "Queue",
 			  Versions =>
 				{
-				  1	=> "3.0.x",
-				  2	=> "3.1.x",
-				  3	=> "3.2.x -> 4.0.x",
-				  4	=> "4.1.x or greater",
+				  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"],
 				}
 			},
 	) ;
@@ -65,17 +65,26 @@ print "testing file $ARGV[0]...\n\n" ;
 open (F, "<$ARGV[0]") or die "Cannot open file $ARGV[0]: $!\n" ;
 
 my $buff ;
-read F, $buff, 20 ;
+read F, $buff, 30 ;
 
-my (@info) = unpack("NNNNN", $buff) ;
-my (@info1) = unpack("VVVVV", $buff) ;
-my ($magic, $version, $endian) ;
 
-if ($Data{$info[0]}) # first try DB 1.x format
+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  = "Unknown" ;
+    $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
 {
@@ -96,8 +105,15 @@ my $type = $Data{$magic} ;
 $magic = sprintf "%06X", $magic ;
 
 my $ver_string = "Unknown" ;
-$ver_string = $type->{Versions}{$version}
-	if defined $type->{Versions}{$version} ;
+
+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.
@@ -105,6 +121,7 @@ File Version ID:	$version
 Built with Berkeley DB:	$ver_string
 Byte Order:		$endian
 Magic:			$magic
+Encryption:             $encrypt
 EOM
 
 close F ;
diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t
index 7dba15d721..5f687a75dd 100755
--- a/ext/DB_File/t/db-hash.t
+++ b/ext/DB_File/t/db-hash.t
@@ -937,6 +937,7 @@ ok(128,1);
     ok(137, $warn_count == 0);
     $warn_count = 0;
 
+    untie %hash1;
     unlink $Dfile;
 }
 
diff --git a/ext/DB_File/t/db-recno.t b/ext/DB_File/t/db-recno.t
index b7f8038ae9..f2cd97bbf1 100755
--- a/ext/DB_File/t/db-recno.t
+++ b/ext/DB_File/t/db-recno.t
@@ -104,7 +104,7 @@ sub bad_one
 	print STDERR <<EOM ;
 #
 # Some older versions of Berkeley DB version 1 will fail db-recno
-# tests 61, 63, 64, and 65.
+# tests 61, 63, 64 and 65.
 EOM
         if ($^O eq 'darwin'
 	    && $Config{db_version_major} == 1