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 <intOp_dbmx*>; 25END { unlink <intOp_dbmx*>; } 26 27my %h1 = () ; 28my $db1 = tie(%h1, $db_file,'intOp_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 1234 => 5678, 37 -3 => -5, 38 "22" => "88", 39 "-45" => "-88", 40 }); 41 42VerifyData(\%h1, 43 { 44 1234 => 5678, 45 -3 => -5, 46 22 => 88, 47 -45 => -88, 48 }); 49 50 51eval { $db1->Filter_Push('int32') }; 52is $@, '', "push an 'int32' filter" ; 53 54{ 55 no warnings 'uninitialized'; 56 StoreData(\%h1, 57 { 58 "400" => "500", 59 undef() => 1, 60 1 => 0, 61 -47 => -6, 62 }); 63 64} 65 66undef $db1; 67{ 68 use warnings FATAL => 'untie'; 69 eval { untie %h1 }; 70 is $@, '', "untie without inner references" ; 71} 72 73# read the dbm file without the filter 74my %h2 = () ; 75my $db2 = tie(%h2, $db_file,'intOp_dbmx', O_RDWR|O_CREAT, 0640) ; 76 77ok $db2, "tied to $db_file"; 78 79VerifyData(\%h2, 80 { 81 1234 => 5678, 82 -3 => -5, 83 22 => 88, 84 -45 => -88, 85 86 #undef() => undef(), 87 pack("i", 400) => pack("i", 500), 88 pack("i", 0) => pack("i", 1), 89 pack("i", 1) => pack("i", 0), 90 pack("i", -47) => pack("i", -6), 91 }); 92 93undef $db2; 94{ 95 use warnings FATAL => 'untie'; 96 eval { untie %h2 }; 97 is $@, '', "untie without inner references" ; 98} 99 100done_testing(); 101