lib/DBM_Filter/t/null.t

   1
   2 use strict;
   3 use warnings;
   4 use Carp;
   5
   6 require "dbm_filter_util.pl";
   7
   8 use Test::More;
   9
  10 BEGIN { use_ok('DBM_Filter') };
  11 my $db_file;
  12 BEGIN {
  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 };
  22 BEGIN { use_ok('Fcntl') };
  23
  24 unlink <Op_dbmx*>;
  25 END { unlink <Op_dbmx*>; }
  26
  27 my %h1 = () ;
  28 my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  29
  30 ok $db1, "tied to $db_file";
  31
  32 # store before adding the filter
  33
  34 StoreData(\%h1,
  35         {
  36                 "abc"   => "def",
  37         });
  38
  39 VerifyData(\%h1,
  40         {
  41                 "abc"   => "def",
  42         });
  43
  44
  45 eval { $db1->Filter_Push('null') };
  46 is $@, '', "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
  70 undef $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
  78 my %h2 = () ;
  79 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  80
  81 ok $db2, "tied to $db_file";
  82
  83 VerifyData(\%h2,
  84         {
  85                 "abc"           => "def",
  86                 "alpha\x00"     => "beta\x00",
  87                 "\x00"          => "\x00",
  88         });
  89
  90 undef $db2;
  91 {
  92     use warnings FATAL => 'untie';
  93     eval { untie %h2 };
  94     is $@, '', "untie without inner references" ;
  95 }
  96
  97 done_testing();