t/11_optimize.t

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