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