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 my $db_file;
  21 BEGIN {
  22     use Config;
  23     foreach (qw/SDBM_File ODBM_File NDBM_File GDBM_File DB_File/) {
  24         if ($Config{extensions} =~ /\b$_\b/) {
  25             $db_file = $_;
  26             last;
  27         }
  28     }
  29     use_ok($db_file);
  30 };
  31 BEGIN { use_ok('Fcntl') };
  32 BEGIN { use_ok('Compress::Zlib') };
  33
  34 unlink <Op_dbmx*>;
  35 END { unlink <Op_dbmx*>; }
  36
  37 my %h1 = () ;
  38 my $db1 = tie(%h1, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  39
  40 ok $db1, "tied to $db_file";
  41
  42 # store before adding the filter
  43
  44 StoreData(\%h1,
  45         {
  46                 1234    => 5678,
  47                 -3      => -5,
  48                 "22"    => "88",
  49                 "-45"   => "-88",
  50                 "fred"  => "Joe",
  51                 "alpha" => "Alpha",
  52                 "Beta"  => "beta",
  53         });
  54
  55 VerifyData(\%h1,
  56         {
  57                 1234    => 5678,
  58                 -3      => -5,
  59                 "22"    => "88",
  60                 "-45"   => "-88",
  61                 "fred"  => "Joe",
  62                 "alpha" => "Alpha",
  63                 "Beta"  => "beta",
  64         });
  65
  66
  67 eval { $db1->Filter_Push('compress') };
  68 is $@, '', "push a 'compress' filter" ;
  69
  70 {
  71     no warnings 'uninitialized';
  72     StoreData(\%h1,
  73         {
  74                 undef() => undef(),
  75                 "400"   => "500",
  76                 0       => 1,
  77                 1       => 0,
  78                 "abc"   => "de0",
  79                 "\x00\x01"      => "\x03\xFF",
  80         });
  81
  82 }
  83
  84 undef $db1;
  85 {
  86     use warnings FATAL => 'untie';
  87     eval { untie %h1 };
  88     is $@, '', "untie without inner references" ;
  89 }
  90
  91 # read the dbm file without the filter
  92 my %h2 = () ;
  93 my $db2 = tie(%h2, $db_file,'Op_dbmx', O_RDWR|O_CREAT, 0640) ;
  94
  95 ok $db2, "tied to $db_file";
  96
  97 VerifyData(\%h2,
  98         {
  99                 1234    => 5678,
 100                 -3      => -5,
 101                 "22"    => "88",
 102                 "-45"   => "-88",
 103                 "fred"  => "Joe",
 104                 "alpha" => "Alpha",
 105                 "Beta"  => "beta",
 106
 107                 compress("")    => compress(""),
 108                 compress("400") => compress("500"),
 109                 compress("0")   => compress("1"),
 110                 compress("1")   => compress("0"),
 111                 compress("abc") => compress("de0"),
 112                 compress("\x00\x01")    => compress("\x03\xFF"),
 113         });
 114
 115 undef $db2;
 116 {
 117     use warnings FATAL => 'untie';
 118     eval { untie %h2 };
 119     is $@, '', "untie without inner references" ;
 120 }
 121