From: Paul Marquess <paul.marquess@btinternet.com>
Date: Sat, 7 Aug 2004 15:22:09 +0000 (+0100)
Subject: DB_File 1.810
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=32babee08ee923133079392c9eae66cc543e1115;p=p5sagit%2Fp5-mst-13.2.git
DB_File 1.810
From: "Paul Marquess" <Paul.Marquess@btinternet.com>
Message-Id: <20040807142059.CTQC10838.mta10-svc.ntlworld.com@MARQUESSPT21>
p4raw-id: //depot/perl@23202
---
diff --git a/ext/DB_File/Changes b/ext/DB_File/Changes
index e74c3e2..89027d1 100644
--- a/ext/DB_File/Changes
+++ b/ext/DB_File/Changes
@@ -1,5 +1,11 @@
+1.810 7th August 2004
+
+ * Fixed db-hash.t for Cygwin
+
+ * Added substr tests to db-hast.t
+
1.809 20th June 2004
* Merged core patch 22258
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
index 3f53d46..5ddac46 100644
--- a/ext/DB_File/DB_File.pm
+++ b/ext/DB_File/DB_File.pm
@@ -1,8 +1,8 @@
# DB_File.pm -- Perl 5 interface to Berkeley DB
#
# written by Paul Marquess (pmqs@cpan.org)
-# last modified 20th June 2004
-# version 1.809
+# last modified 7th August 2004
+# version 1.810
#
# Copyright (c) 1995-2004 Paul Marquess. All rights reserved.
# This program is free software; you can redistribute it and/or
@@ -165,7 +165,7 @@ our ($db_version, $use_XSLoader, $splice_end_array);
use Carp;
-$VERSION = "1.809" ;
+$VERSION = "1.810" ;
{
local $SIG{__WARN__} = sub {$splice_end_array = "@_";};
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index eb83670..8f6cec1 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -3,8 +3,8 @@
DB_File.xs -- Perl 5 interface to Berkeley DB
written by Paul Marquess <pmqs@cpan.org>
- last modified 20th June 2004
- version 1.809
+ last modified 7th August 2004
+ version 1.810
All comments/suggestions/problems are welcome
@@ -109,6 +109,7 @@
1.807 - no change
1.808 - leak fixed in ParseOpenInfo
1.809 - no change
+ 1.810 - no change
*/
@@ -397,8 +398,9 @@ typedef DBT DBTKEY ;
#define OutputValue(arg, name) \
{ if (RETVAL == 0) { \
+ SvGETMAGIC(arg) ; \
my_sv_setpvn(arg, name.data, name.size) ; \
- TAINT; \
+ TAINT; \
SvTAINTED_on(arg); \
SvUTF8_off(arg); \
DBM_ckFilter(arg, filter_fetch_value,"filter_fetch_value") ; \
@@ -408,12 +410,13 @@ typedef DBT DBTKEY ;
#define OutputKey(arg, name) \
{ if (RETVAL == 0) \
{ \
+ SvGETMAGIC(arg) ; \
if (db->type != DB_RECNO) { \
my_sv_setpvn(arg, name.data, name.size); \
} \
else \
sv_setiv(arg, (I32)*(I32*)name.data - 1); \
- TAINT; \
+ TAINT; \
SvTAINTED_on(arg); \
SvUTF8_off(arg); \
DBM_ckFilter(arg, filter_fetch_key,"filter_fetch_key") ; \
diff --git a/ext/DB_File/t/db-hash.t b/ext/DB_File/t/db-hash.t
index 86a64ff..018952f 100755
--- a/ext/DB_File/t/db-hash.t
+++ b/ext/DB_File/t/db-hash.t
@@ -23,7 +23,7 @@ BEGIN {
use DB_File;
use Fcntl;
-print "1..161\n";
+print "1..166\n";
unlink glob "__db.*";
@@ -877,14 +877,14 @@ EOM
#
# ok(128, $@ =~ /^DB_File hash callback: recursion detected/);
# {
-# local ($^W) = 0; #no warnings;
+# no warnings;
# untie %hash;
# }
# unlink $Dfile;
#}
-#ok(127,1);
-#ok(128,1);
+#ok(127, 1);
+#ok(128, 1);
{
# Check that two hash's don't interact
@@ -934,9 +934,11 @@ EOM
tie %hash1, 'DB_File',$Dfile, undef;
ok(133, $warn_count == 0);
$warn_count = 0;
+ untie %hash1;
unlink $Dfile;
tie %hash1, 'DB_File',$Dfile, O_RDWR|O_CREAT, undef;
ok(134, $warn_count == 0);
+ untie %hash1;
unlink $Dfile;
tie %hash1, 'DB_File',$Dfile, undef, undef;
ok(135, $warn_count == 0);
@@ -1113,9 +1115,9 @@ EOM
my %bad = () ;
$key = '';
- for ($status = $db->seq($key, $value, R_FIRST ) ;
+ for ($status = $db->seq(substr($key,0), substr($value,0), R_FIRST ) ;
$status == 0 ;
- $status = $db->seq($key, $value, R_NEXT ) ) {
+ $status = $db->seq(substr($key,0), substr($value,0), R_NEXT ) ) {
#print "# key [$key] value [$value]\n" ;
if (defined $remember{$key} && defined $value &&
@@ -1130,11 +1132,11 @@ EOM
ok 157, keys %bad == 0 ;
ok 158, keys %remember == 0 ;
- print "# missing -- $key $value\n" while ($key, $value) = each %remember;
- print "# bad -- $key $value\n" while ($key, $value) = each %bad;
+ print "# missing -- $key=>$value\n" while ($key, $value) = each %remember;
+ print "# bad -- $key=>$value\n" while ($key, $value) = each %bad;
# Make sure this fix does not break code to handle an undef key
- # Berkeley DB undef key is bron between versions 2.3.16 and
+ # Berkeley DB undef key is broken between versions 2.3.16 and 3.1
my $value = 'fred';
$warned = '';
$db->put(undef, $value) ;
@@ -1156,4 +1158,74 @@ EOM
unlink $Dfile;
}
+{
+ # Check filter + substr
+
+ use warnings ;
+ use strict ;
+ my (%h, $db) ;
+ my $Dfile = "xxy.db";
+ unlink $Dfile;
+
+ ok(162, $db = tie(%h, 'DB_File', $Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH ) );
+
+
+ {
+ $db->filter_fetch_key (sub { lc $_ } );
+ $db->filter_store_key (sub { uc $_ } );
+ $db->filter_fetch_value (sub { lc $_ } );
+ $db->filter_store_value (sub { uc $_ } );
+ }
+
+ $_ = 'fred';
+
+ # db-put with substr of key
+ my %remember = () ;
+ my $status = 0 ;
+ for my $ix ( 1 .. 2 )
+ {
+ my $key = $ix . "data" ;
+ my $value = "value$ix" ;
+ $remember{$key} = $value ;
+ $status += $db->put(substr($key,0), substr($value,0)) ;
+ }
+
+ ok 163, $status == 0 or print "# Status $status\n" ;
+
+ if (1)
+ {
+ $db->filter_fetch_key (undef);
+ $db->filter_store_key (undef);
+ $db->filter_fetch_value (undef);
+ $db->filter_store_value (undef);
+ }
+
+ my %bad = () ;
+ my $key = '';
+ my $value = '';
+ for ($status = $db->seq($key, $value, R_FIRST ) ;
+ $status == 0 ;
+ $status = $db->seq($key, $value, R_NEXT ) ) {
+
+ #print "# key [$key] value [$value]\n" ;
+ if (defined $remember{$key} && defined $value &&
+ $remember{$key} eq $value) {
+ delete $remember{$key} ;
+ }
+ else {
+ $bad{$key} = $value ;
+ }
+ }
+
+ ok 164, $_ eq 'fred';
+ ok 165, keys %bad == 0 ;
+ ok 166, keys %remember == 0 ;
+
+ print "# missing -- $key $value\n" while ($key, $value) = each %remember;
+ print "# bad -- $key $value\n" while ($key, $value) = each %bad;
+ undef $db ;
+ untie %h;
+ unlink $Dfile;
+}
+
exit ;