1 2use strict; 3use warnings; 4use Carp; 5 6require "dbm_filter_util.pl"; 7 8use Test::More tests => 26; 9 10BEGIN { use_ok('DBM_Filter') }; 11BEGIN { use_ok('SDBM_File') }; 12BEGIN { use_ok('Fcntl') }; 13 14unlink <Op_dbmx*>; 15END { unlink <Op_dbmx*>; } 16 17my %h1 = () ; 18my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; 19 20ok $db1, "tied to SDBM_File"; 21 22# store before adding the filter 23 24StoreData(\%h1, 25 { 26 "abc" => "def", 27 }); 28 29VerifyData(\%h1, 30 { 31 "abc" => "def", 32 }); 33 34 35eval { $db1->Filter_Push('null') }; 36is $@, '', "push a 'null' filter" ; 37 38{ 39 no warnings 'uninitialized'; 40 StoreData(\%h1, 41 { 42 undef() => undef(), 43 "alpha" => "beta", 44 }); 45 46 VerifyData(\%h1, 47 { 48 undef() => undef(), 49 "abc" => "", # not "def", because the filter is in place 50 "alpha" => "beta", 51 }); 52} 53 54 while (my ($k, $v) = each %h1) { 55 no warnings 'uninitialized'; 56 #diag "After Match [$k][$v]"; 57 } 58 59 60undef $db1; 61{ 62 use warnings FATAL => 'untie'; 63 eval { untie %h1 }; 64 is $@, '', "untie without inner references" ; 65} 66 67# read the dbm file without the filter, check for null termination 68my %h2 = () ; 69my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ; 70 71ok $db2, "tied to SDBM_File"; 72 73VerifyData(\%h2, 74 { 75 "abc" => "def", 76 "alpha\x00" => "beta\x00", 77 "\x00" => "\x00", 78 }); 79 80undef $db2; 81{ 82 use warnings FATAL => 'untie'; 83 eval { untie %h2 }; 84 is $@, '', "untie without inner references" ; 85} 86 87