lib/DBM_Filter/t/compress.t

   1
   2 use strict;
   3 use warnings;
   4 use Carp;
   5
   6 BEGIN
   7 {
   8     eval { require Compress::Zlib ; };
   9     if ($@) {
  10         print "1..0 # Skip: Compress::Zlib is not available\n";
  11 print "# $@\n";
  12         exit 0;
  13     }
  14 }
  15 require "dbm_filter_util.pl";
  16
  17 use Test::More tests => 23;
  18
  19 BEGIN { use_ok('DBM_Filter') };
  20 BEGIN { use_ok('SDBM_File') };
  21 BEGIN { use_ok('Fcntl') };
  22 BEGIN { use_ok('Compress::Zlib') };
  23
  24 unlink <Op_dbmx*>;
  25 END { unlink <Op_dbmx*>; }
  26
  27 my %h1 = () ;
  28 my $db1 = tie(%h1, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  29
  30 ok $db1, "tied to SDBM_File";
  31
  32 # store before adding the filter
  33
  34 StoreData(\%h1,
  35         {
  36                 1234    => 5678,
  37                 -3      => -5,
  38                 "22"    => "88",
  39                 "-45"   => "-88",
  40                 "fred"  => "Joe",
  41                 "alpha" => "Alpha",
  42                 "Beta"  => "beta",
  43         });
  44
  45 VerifyData(\%h1,
  46         {
  47                 1234    => 5678,
  48                 -3      => -5,
  49                 "22"    => "88",
  50                 "-45"   => "-88",
  51                 "fred"  => "Joe",
  52                 "alpha" => "Alpha",
  53                 "Beta"  => "beta",
  54         });
  55
  56
  57 eval { $db1->Filter_Push('compress') };
  58 is $@, '', "push a 'compress' filter" ;
  59
  60 {
  61     no warnings 'uninitialized';
  62     StoreData(\%h1,
  63         {
  64                 undef() => undef(),
  65                 "400"   => "500",
  66                 0       => 1,
  67                 1       => 0,
  68                 "abc"   => "de0",
  69                 "\x00\x01"      => "\x03\xFF",
  70         });
  71
  72 }
  73
  74 undef $db1;
  75 {
  76     use warnings FATAL => 'untie';
  77     eval { untie %h1 };
  78     is $@, '', "untie without inner references" ;
  79 }
  80
  81 # read the dbm file without the filter
  82 my %h2 = () ;
  83 my $db2 = tie(%h2, 'SDBM_File','Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  84
  85 ok $db2, "tied to SDBM_File";
  86
  87 VerifyData(\%h2,
  88         {
  89                 1234    => 5678,
  90                 -3      => -5,
  91                 "22"    => "88",
  92                 "-45"   => "-88",
  93                 "fred"  => "Joe",
  94                 "alpha" => "Alpha",
  95                 "Beta"  => "beta",
  96
  97                 compress("")    => compress(""),
  98                 compress("400") => compress("500"),
  99                 compress("0")   => compress("1"),
 100                 compress("1")   => compress("0"),
 101                 compress("abc") => compress("de0"),
 102                 compress("\x00\x01")    => compress("\x03\xFF"),
 103         });
 104
 105 undef $db2;
 106 {
 107     use warnings FATAL => 'untie';
 108     eval { untie %h2 };
 109     is $@, '', "untie without inner references" ;
 110 }
 111