From: Paul Marquess 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" 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 - 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 ;