t/store.t

   1 # -*-perl-*-
   2
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use FindBin qw($Bin);
   7
   8 use MogileFS::Server;
   9 use MogileFS::Util qw(error_code);
  10 use MogileFS::Test;
  11
  12 my $sto = eval { temp_store(); };
  13 if (!$sto) {
  14     plan skip_all => "Can't create temporary test database: $@";
  15     exit 0;
  16 }
  17
  18 my $dmid = $sto->create_domain("foo");
  19 ok($dmid, "created a domain");
  20 my $clsid = $sto->create_class($dmid, "classA");
  21 ok($clsid, "created a class");
  22
  23 my $df = MogileFS::DevFID->new(100, 200);
  24 ok($df, "made devfid");
  25 ok($df->add_to_db, "added to db");
  26
  27 my $fid = $df->fid;
  28 ok($fid, "got fid from df");
  29 my @on = $fid->devids;
  30 is(scalar @on, 1, "FID 200 on one device");
  31 is($on[0], 100, "is correct number");
  32
  33 ok($sto->mass_insert_file_on(MogileFS::DevFID->new(1, 101),
  34                              MogileFS::DevFID->new(2, 101)), "did mass insert");
  35 $fid = MogileFS::FID->new(101);
  36 @on = $fid->devids;
  37 is(scalar @on, 2, "FID 101 on 2 devices");
  38
  39 # create a tempfile
  40 {
  41     my $fidid = $sto->register_tempfile(
  42                                         fid     => undef,
  43                                         dmid    => $dmid,
  44                                         key     => "my_tempfile",
  45                                         classid => $clsid,
  46                                         devids  => join(',', 1,2,3),
  47                                         );
  48     ok($fidid, "got a fidid");
  49
  50     my $fidid2 = eval {
  51         $sto->register_tempfile(
  52                                 fid     => $fidid,
  53                                 dmid    => $dmid,
  54                                 key     => "my_tempfile",
  55                                 classid => $clsid,
  56                                 devids  => join(',', 1,2,3),
  57                                 );
  58     };
  59     my $errc = error_code($@);
  60     ok(!$fidid2, "didn't get fidid");
  61     is($errc, "dup", "got a dup into tempfile")
  62         or die "Got error: $@\n";
  63 }
  64
  65 my $ignore_replace_match = {
  66     base     => { pattern => undef, dies => 1 },
  67     MySQL    => { pattern => qr/INSERT IGNORE/, dies => 0 },
  68     SQLite   => { pattern => qr/REPLACE/, dies => 0 },
  69     Postgres => { pattern => undef, dies => 1 },
  70 };
  71
  72 my $prx = eval { $sto->ignore_replace } || '';
  73 my $sto_driver = ( split( /::/, ref($sto) ) )[2] || 'base';
  74 my $match_spec = $ignore_replace_match->{ $sto_driver }
  75     or die "Test not configured for '$sto_driver' storage driver";
  76
  77
  78 ok(
  79     ref( $match_spec->{pattern} ) eq 'Regexp'?
  80         ( $prx =~ $match_spec->{pattern} ) :
  81         ( !$prx ),
  82     sprintf(
  83         "ignore_replace %s return value for storage type '%s'",
  84         ref( $match_spec->{pattern} ) eq 'Regexp'?
  85             'should' : 'should not',
  86         $sto_driver
  87     )
  88 ) or diag "Got value: $prx";
  89
  90 ok(
  91     $match_spec->{dies}? $@ : !$@,
  92     sprintf(
  93         "ignore_replace %s die for storage type '%s'",
  94         $match_spec->{dies}? 'should' : 'should not',
  95         $sto_driver
  96     )
  97 ) or diag "Got exception: $@";
  98
  99 my $rv;
 100
 101 # test retry_on_deadlock using good sql
 102 $rv = eval {
 103     $sto->retry_on_deadlock( sub { $sto->dbh->do("SELECT 1;"); } );
 104 };
 105 ok (
 106     $rv eq '1' || $rv eq '0E0',
 107     "retry_on_deadlock return value for '$sto_driver': $rv"
 108 ) or diag "Got return value: $rv";
 109
 110 # test retry_on_deadlock using bad sql
 111 $rv = eval {
 112     $sto->retry_on_deadlock( sub { $sto->dbh->do("BADSQL;"); } );
 113 };
 114 ok (
 115     $@ =~ /BADSQL/,
 116     "retry_on_deadlock got an exception on bad sql '$sto_driver'"
 117 ) or diag "Got exception value: $@";
 118
 119 # test retry_on_deadlock using a custom exception
 120 $rv = eval {
 121     $sto->retry_on_deadlock( sub { die "preempt"; } );
 122 };
 123 ok (
 124     $@ =~ /preempt/,
 125     "retry_on_deadlock got a non-sql exception for '$sto_driver'"
 126 ) or diag $@;
 127
 128 sub _do_induce_deadlock {
 129     my @args = @_;
 130     return eval {
 131         no strict 'refs';
 132         no warnings 'redefine';
 133         my $c = 0;
 134         local *{ "MogileFS\::Store\::$sto_driver\::was_deadlock_error" } = sub {
 135             return $c++ < 2; # unlock on third try
 136         };
 137         $sto->retry_on_deadlock( @args );
 138     };
 139 }
 140
 141 # attempt to induce a deadlock and check iterations
 142 my $_v = 0;
 143 $rv = _do_induce_deadlock( sub { return $_v++; } );
 144
 145 ok(
 146    !$@,
 147    "no exception on retry_on_deadlock while inducing a deadlock"
 148 ) or diag $@;
 149
 150 ok(
 151     $rv == 2,
 152     'retry_on_deadlock returned good iteration count while inducing a deadlock'
 153 ) or diag $rv;
 154
 155 # induce a deadlock using badsql... should return an exemption
 156 $rv = _do_induce_deadlock( sub { $sto->dbh->do("BADSQL;"); } );
 157 ok (
 158     !$rv && $@ =~ /BADSQL/,
 159     "retry_on_deadlock got expected exemption inducing a deadlock with bad sql"
 160 ) or diag "Got value '$rv' with exemption: $@";
 161
 162 # induce a deadlock with good sql check sql return and iterations
 163 $_v = 0;
 164 $rv = _do_induce_deadlock(
 165     sub {
 166         return [ $sto->dbh->do("SELECT 1;"), $_v++ ];
 167     }
 168 );
 169 ok (
 170     ( !$@ && ref($rv) eq 'ARRAY' ) && (
 171         ( $rv->[0] eq '1' || $rv->[0] eq '0E0' ) &&
 172         $rv->[1] == 2
 173     ),
 174     "retry_on_deadlock got proper return value and iteration while inducing a deadlock"
 175 );
 176
 177 use Digest::MD5 qw(md5);
 178
 179 $sto->set_checksum(6, 1, md5("FOO"));
 180 my $hash = $sto->get_checksum(6);
 181 ok($hash->{checksum} eq md5("FOO"), "checksum matches expected");
 182 ok($hash->{fid} == 6, "checksum fid set correctly");
 183 ok($hash->{hashtype} == 1, "hashtype set correctly");
 184
 185 $sto->set_checksum(6, 2, md5("MOO"));
 186 $hash = $sto->get_checksum(6);
 187 ok($hash->{checksum} eq md5("MOO"), "checksum matches expected");
 188 ok($hash->{fid} == 6, "checksum fid set correctly");
 189 ok($hash->{hashtype} == 2, "hashtype set correctly");
 190
 191 ok(1 == $sto->delete_checksum(6), "checksum deleted OK");
 192 ok(0 == $sto->delete_checksum(6), "checksum delete MISS");
 193 ok(!defined $sto->get_checksum(6), "undef on missing checksum");
 194
 195 # case-sensitivity tests for list_keys
 196 my %arg = (
 197     fidid => 1234,
 198     dmid => $dmid,
 199     key => 'Case_Sensitive_Clod',
 200     length => 1,
 201     classid => $clsid,
 202     devcount => 1
 203 );
 204 $sto->replace_into_file(%arg);
 205 my $rows;
 206
 207 # ensure existing (broken) case-insensitive list_keys works for MySQL/SQLite
 208 # LIKE is always case-sensitive in Postgres, so its behavior for list_keys
 209 # was never broken.
 210 $rows = $sto->get_keys_like($dmid, "case", undef, 1000);
 211 if (ref($sto) eq "MogileFS::Store::Postgres") {
 212     ok(scalar @$rows == 0, "Postgres list_keys is case-sensitive");
 213 } else {
 214     ok($rows->[0] eq 'Case_Sensitive_Clod', "list_keys matches insensitively");
 215 }
 216
 217 # make list_keys case-sensitive
 218 MogileFS::Config->set_server_setting("case_sensitive_list_keys", 1);
 219 MogileFS::Config->cache_server_setting("case_sensitive_list_keys", 1);
 220
 221 $rows = $sto->get_keys_like($dmid, "case", undef, 1000);
 222 ok(scalar @$rows == 0, "case-incorrect list_keys fails to match");
 223 $rows = $sto->get_keys_like($dmid, "Case", undef, 1000);
 224 ok($rows->[0] eq 'Case_Sensitive_Clod', "case-correct list_keys matches");
 225 ok(scalar @$rows == 1, "only one row matched");
 226
 227 # make list_keys case-insensitive again
 228 MogileFS::Config->set_server_setting("case_sensitive_list_keys", 0);
 229 MogileFS::Config->cache_server_setting("case_sensitive_list_keys", 0);
 230
 231 $rows = $sto->get_keys_like($dmid, "case", undef, 1000);
 232 if (ref($sto) eq "MogileFS::Store::Postgres") {
 233     ok(scalar @$rows == 0, "Postgres list_keys is case-sensitive");
 234 } else {
 235     ok($rows->[0] eq 'Case_Sensitive_Clod', "list_keys matches insensitively (again)");
 236 }
 237
 238 done_testing();