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 unlocks # 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