#!/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();

##</code><code>##

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

##</code><code>##

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();