#!/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 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

done_testing();