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

In reply to Locking a SQLite DB for tests by bliako

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.