http://qs321.pair.com?node_id=11140891

I needed to lock a SQLite(3) database in order to test whether my code for writing to it fails gracefully, or my code for reading circumvents the lock by, lamely, copying it to a new file.

After some help from Discipulus' google-fu I have ended using this for locking the DB: PRAGMA locking_mode = EXCLUSIVE; BEGIN EXCLUSIVE; . (unfortunately unlocking it with COMMIT; does not work for me and I unlock it with a disconnect).

The test file will use a fork() whose child will open the db and lock it as above and sleep for some time before disconnecting (thus unlocking it). The parent will try to open the DB and hopefully be able to detect if locked or not.

Here's the code:

#!/usr/bin/perl
use lib 'lib';
use strict;
use warnings;

# WARNING: Test::More obviously gets a bit confused with the fork
# there's also Test::Fork
use Test::More;
use DBI;
use DBD::SQLite;

my $dbfile = 'abc.sqlite';

my $pid = fork();
if( not $pid ){
  my $dbh = DBI->connect(
    "dbi:SQLite:dbname=$dbfile",
    '', '',
    {
      RaiseError => 0, # don't die on error
      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE
        | DBD::SQLite::OPEN_CREATE
    }
  );
  ok(defined $dbh, "connect()");
  # this causes the driver to timeout and not to wait
  # for the lock forever
  $dbh->sqlite_busy_timeout(1000); # milliseconds
  my $SQL = 'PRAGMA locking_mode = EXCLUSIVE';
  my $ret = eval { $dbh->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  $SQL = 'BEGIN EXCLUSIVE';
  $ret = eval { $dbh->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  # now db is locked, we have 15 seconds
  # to test the locked db before unlock
  sleep 15;
  $dbh->disconnect();
  diag("DB is now unlocked.");
  exit;
}

# parent
# give some  time for our child to lock the db
sleep 2; # we now have 13 seconds to finish all tests before db unlock
+s

# check that the db is locked
my $dbh = DBI->connect(
  "dbi:SQLite:dbname=$dbfile",
  '', '',
  {
    RaiseError => 0, # don't die
    sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
    TraceLevel => 1,
  }
);
ok(defined $dbh, "connected to db '$dbfile'.");
# set this to a short timeout (millis) because it can wait forever
# and our child will be dead soon!
$dbh->sqlite_busy_timeout(1000);
my $SQL = 'BEGIN IMMEDIATE';
my $ret = eval { $dbh->do($SQL) };
ok(!defined $ret, "database is locked and SQL must fail: '$SQL'.");
$dbh->disconnect;

wait; # for our child

done_testing();

[download]

Update:

And here is the code with Test::More Test::Fork which may be necessary as Test::More gets confused with the fork.

use strict;
use warnings;

use Test::More tests => 1+3+2;
use Test::Fork;
use DBI;
use DBD::SQLite;

my $dbfile = 'abc.sqlite';

fork_ok(3, sub {
  my $dbh = DBI->connect(
    "dbi:SQLite:dbname=$dbfile",
    '', '',
    {
      RaiseError => 0, # don't die on error
      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE
        | DBD::SQLite::OPEN_CREATE
    }
  );
  ok(defined $dbh, "connect()");
  # this causes the driver to timeout and not to wait
  # for the lock forever
  $dbh->sqlite_busy_timeout(1000); # milliseconds
  my $SQL = 'PRAGMA locking_mode = EXCLUSIVE';
  my $ret = eval { $dbh->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  $SQL = 'BEGIN EXCLUSIVE';
  $ret = eval { $dbh->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  # now db is locked, we have 15 seconds
  # to test the locked db before unlock
  sleep 15;
  # TODO: how do we unlock the beast?
  # ROLLBACK; or COMMIT; nothing works
  $dbh->disconnect();
  diag("DB is now unlocked.");
});

# parent
# give some  time for our child to lock the db
sleep 2; # we now have 13 seconds to finish all tests before db unlock
+s

# check that the db is locked
my $dbh = DBI->connect(
  "dbi:SQLite:dbname=$dbfile",
  '', '',
  {
    RaiseError => 0, # don't die
    sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
    TraceLevel => 1,
  }
);
ok(defined $dbh, "connected to db '$dbfile'.");
# set this to a short timeout (millis) because it can wait forever
# and our child will be dead soon!
$dbh->sqlite_busy_timeout(1000);
my $SQL = 'BEGIN IMMEDIATE';
my $ret = eval { $dbh->do($SQL) };
ok(!defined $ret, "database is locked and SQL must fail: '$SQL'.");
$dbh->disconnect;

#wait; # for our child, this is handled by fork_ok

#done_testing(); not needed

[download]

Another update without the fork. Thinking again about it, there is no need for a fork, see Re^2: Locking a SQLite DB for tests. Sohere is one without the fork:

use strict;
use warnings;

use Test::More;
use DBI;
use DBD::SQLite;

my $dbfile = 'abc.sqlite';

# we are opening the same database and at some point
# we have the same DB opened with 2 different handles
# First time here to lock it
  my $dbh_locked = DBI->connect(
    "dbi:SQLite:dbname=$dbfile",
    '', '',
    {
      RaiseError => 0, # don't die on error
      sqlite_open_flags => DBD::SQLite::OPEN_READWRITE
        | DBD::SQLite::OPEN_CREATE
    }
  );
  ok(defined $dbh_locked, "connect()");
  # this causes the driver to timeout and not to wait
  # for the lock forever
  $dbh_locked->sqlite_busy_timeout(1000); # milliseconds
  my $SQL = 'PRAGMA locking_mode = EXCLUSIVE';
  my $ret = eval { $dbh_locked->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  $SQL = 'BEGIN EXCLUSIVE';
  $ret = eval { $dbh_locked->do($SQL) };
  ok(defined $ret, "do SQL: $SQL");
  # now db is locked, we have 15 seconds
  # to test the locked db before unlock
  diag("DB is now locked.");

# Second time, we open the DB here to check if it's locked
# check that the db is locked
my $dbh = DBI->connect(
  "dbi:SQLite:dbname=$dbfile",
  '', '',
  {
    RaiseError => 0, # don't die
    sqlite_open_flags => DBD::SQLite::OPEN_READONLY,
    TraceLevel => 1,
  }
);
ok(defined $dbh, "connected to db '$dbfile'.");
# set this to a short timeout (millis) because it can wait forever
# and our child will be dead soon!
$dbh->sqlite_busy_timeout(1000);
$SQL = 'BEGIN IMMEDIATE';
$ret = eval { $dbh->do($SQL) };
ok(!defined $ret, "database is locked and SQL must fail: '$SQL'.");
$dbh->disconnect;

$dbh_locked->disconnect;

done_testing();

[download]

Suggestions and improvements welcome. Also any advice on what Test module to use for code involving forks. There is Test::Fork which has many warnings and failed tests. See Update and also Re^2: Locking a SQLite DB for tests below by 1nickt..

bw, bliako

Back to Meditations