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 if ($db->error()) {
  15         die "ERROR: " . $db->error();
  16 }
  17
  18 ##
  19 # create some unused space
  20 ##
  21 $db->{key1} = "value1";
  22 $db->{key2} = "value2";
  23
  24 $db->{a} = {};
  25 $db->{a}{b} = [];
  26 $db->{a}{c} = 'value2';
  27
  28 my $b = $db->{a}->{b};
  29 $b->[0] = 1;
  30 $b->[1] = 2;
  31 $b->[2] = {};
  32 $b->[2]->{c} = [];
  33
  34 my $c = $b->[2]->{c};
  35 $c->[0] = 'd';
  36 $c->[1] = {};
  37 $c->[1]->{e} = 'f';
  38
  39 undef $c;
  40 undef $b;
  41
  42 delete $db->{key2};
  43 delete $db->{a}{b};
  44
  45 ##
  46 # take byte count readings before, and after optimize
  47 ##
  48 my $before = (stat($db->fh()))[7];
  49 my $result = $db->optimize();
  50 my $after = (stat($db->fh()))[7];
  51
  52 if ($db->error()) {
  53         die "ERROR: " . $db->error();
  54 }
  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 ##
  63 # now for the tricky one -- try to store a new key while file is being
  64 # optimized and locked by another process.  filehandle should be invalidated,
  65 # and automatically re-opened transparently.  Cannot test on Win32, due to
  66 # problems with fork()ing, flock()ing, etc.  Win32 very bad.
  67 ##
  68
  69 if ( $^O eq 'MSWin32' ) {
  70         ok(1, "Skipping test on this platform");
  71         ok(1, "Skipping test on this platform");
  72         ok(1, "Skipping test on this platform");
  73         ok(1, "Skipping test on this platform");
  74         exit(1);
  75 }
  76
  77 ##
  78 # first things first, get us about 1000 keys so the optimize() will take
  79 # at least a few seconds on any machine, and re-open db with locking
  80 ##
  81 for (1..1000) { $db->STORE( $_, $_ ); }
  82 undef $db;
  83
  84 ##
  85 # now, fork a process for the optimize()
  86 ##
  87 my $pid = fork();
  88 ok( defined($pid), "fork was successful" ); # make sure fork was successful
  89
  90 if ($pid) {
  91         # parent fork
  92
  93         # re-open db
  94         $db = DBM::Deep->new(
  95                 file => "t/test.db",
  96                 autoflush => 1,
  97                 locking => 1
  98         );
  99         if ($db->error()) {
 100                 die "ERROR: " . $db->error();
 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 }
 117 else {
 118         # child fork
 119
 120         # re-open db
 121         $db = DBM::Deep->new(
 122                 file => "t/test.db",
 123                 autoflush => 1,
 124                 locking => 1
 125         );
 126         if ($db->error()) {
 127                 die "ERROR: " . $db->error();
 128         }
 129
 130         # optimize and exit
 131         $db->optimize();
 132
 133         ok(1, "Ignore this, we're in a fork");
 134         ok(1, "Ignore this, we're in a fork");
 135         ok(1, "Ignore this, we're in a fork");
 136         exit(0);
 137 }
 138
 139 1;