t/11_optimize.t

   1 use strict;
   2 use warnings FATAL => 'all';
   3
   4 use Test::More;
   5
   6 plan skip_all => "Skipping the optimize tests on Win32/cygwin for now."
   7     if ( $^O eq 'MSWin32' || $^O eq 'cygwin' );
   8
   9 use t::common qw( new_fh );
  10
  11 use_ok( 'DBM::Deep' );
  12
  13 my ($fh, $filename) = new_fh();
  14 my $db = DBM::Deep->new(
  15     file => $filename,
  16     autoflush => 1,
  17 );
  18
  19 ##
  20 # create some unused space
  21 ##
  22 $db->{key1} = "value1";
  23 $db->{key2} = "value2";
  24
  25 $db->{a} = {};
  26 $db->{a}{b} = [];
  27 $db->{a}{c} = 'value2';
  28
  29 my $b = $db->{a}->{b};
  30 $b->[0] = 1;
  31 $b->[1] = 2;
  32 $b->[2] = {};
  33 $b->[2]->{c} = [];
  34
  35 my $c = $b->[2]->{c};
  36 $c->[0] = 'd';
  37 $c->[1] = {};
  38 $c->[1]->{e} = 'f';
  39
  40 undef $c;
  41 undef $b;
  42
  43 delete $db->{key2};
  44 delete $db->{a}{b};
  45
  46 ##
  47 # take byte count readings before, and after optimize
  48 ##
  49 my $before = (stat($filename))[7];
  50 my $result = $db->optimize();
  51 my $after = (stat($filename))[7];
  52
  53 ok( $result, "optimize succeeded" );
  54 ok( $after < $before, "file size has shrunk" ); # make sure file shrunk
  55
  56 is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
  57 is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
  58
  59 $db->_get_self->_engine->storage->close( $db->_get_self );
  60
  61 ##
  62 # now for the tricky one -- try to store a new key while file is being
  63 # optimized and locked by another process.  filehandle should be invalidated,
  64 # and automatically re-opened transparently.  Cannot test on Win32, due to
  65 # problems with fork()ing, flock()ing, etc.  Win32 very bad.
  66 ##
  67
  68 SKIP: {
  69     skip "Fork tests skipped until fh/filename question solved.", 4;
  70     skip "Fork tests skipped on Win32", 4
  71         if $^O eq 'MSWin32' || $^O eq 'cygwin';
  72
  73     ##
  74     # first things first, get us about 1000 keys so the optimize() will take
  75     # at least a few seconds on any machine, and re-open db with locking
  76     ##
  77     for (1..1000) { $db->STORE( $_, $_ +1 ); }
  78     undef $db;
  79
  80     ##
  81     # now, fork a process for the optimize()
  82     ##
  83     my $pid = fork();
  84
  85     unless ( $pid ) {
  86         # child fork
  87
  88         # re-open db
  89         $db = DBM::Deep->new(
  90             file => $filename,
  91             autoflush => 1,
  92             locking => 1
  93         );
  94
  95         # optimize and exit
  96         $db->optimize();
  97
  98         exit( 0 );
  99     }
 100     # parent fork
 101     ok( defined($pid), "fork was successful" ); # make sure fork was successful
 102
 103     # re-open db
 104     $db = DBM::Deep->new(
 105         file => $filename,
 106         autoflush => 1,
 107         locking => 1
 108     );
 109
 110     # sleep for 1 second to make sure optimize() is running in the other fork
 111     sleep(1);
 112
 113     # now, try to get a lock and store a key
 114     $db->{parentfork} = "hello";
 115
 116     # see if it was stored successfully
 117     is( $db->{parentfork}, "hello", "stored key while optimize took place" );
 118
 119     undef $db;
 120     $db = DBM::Deep->new(
 121         file => $filename,
 122         autoflush => 1,
 123         locking => 1
 124     );
 125
 126     # now check some existing values from before
 127     is( $db->{key1}, 'value1', "key1's value is still there after optimize" );
 128     is( $db->{a}{c}, 'value2', "key2's value is still there after optimize" );
 129 }
 130
 131 done_testing;