t/11_optimize.t

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